Mocto:={{1,0,1,-1},{0,1,1,1},{1,1,1,0},{-1,1,0,1}};
s:=1/Sqrt[2];

P:={{-0.5,0.5,0.5,-0.5},{0.5,0.5,-0.5,-0.5},{0,s,0,s},{s,0,s,0}};
Pinv:=Inverse[P];
Projepar:=0.5*{{1,0,s,-s},{0,1,s,s},{s,s,1,0},{-s,s,0,1}};
Projeperp:=0.5*{{1,0,-s,s},{0,1,-s,-s},{-s,-s,1,0},{s,-s,0,1}};

Pk[k_]:={{-0.5,0.5,0.5,-0.5},{0.5,0.5,-0.5,-0.5},{0,iuk[[k]],0,iuk[[k]]},{iuk[[k]],0,iuk[[k]],0}};

Pinvk[k_]:=Inverse[Pk[k]];

Projepark[k_]:=0.5*{{1,0,iuk[[k]],-iuk[[k]]},{0,1,iuk[[k]],iuk[[k]]},{iuk[[k]],iuk[[k]],1,0},{-iuk[[k]],iuk[[k]],0,1}};
Projeperpk[k_]:=0.5*{{1,0,-iuk[[k]],iuk[[k]]},{0,1,-iuk[[k]],-iuk[[k]]},{-iuk[[k]],-iuk[[k]],1,0},{iuk[[k]],-iuk[[k]],0,1}};

uk:={1};

For[kl=1,kl<16,kl++,AppendTo[uk,(uk[[kl]]+2/uk[[kl]])/2]];

Length[uk]

N[uk[[3]]]

iuk[[2]]

N[iuk[[4]]*iuk[[4]]]

For[kl=1,kl<12,kl++,AppendTo[iuk,2*iuk[[kl]]/(1+2*iuk[[kl]]*iuk[[kl]])]];

N[1/Sqrt[2]]

0.7071067811865475`
ArHypCube:={{0,0,0,0},{1,0,0,0},{0,1,0,0},{0,0,1,0},{1,1,0,0},{1,0,1,0},{0,1,1,0},{1,1,1,0},{0,0,0,1},{1,0,0,1},{0,1,0,1},{0,0,1,1},{1,1,0,1},{1,0,1,1},{0,1,1,1},{1,1,1,1}}

PPolyg:={Projeperp.{0,0,0,0},Projeperp.{1,0,0,0},Projeperp.{0,1,0,0},Projeperp.{0,0,1,0},Projeperp.{1,1,0,0},Projeperp.{1,0,1,0},Projeperp.{0,1,1,0},Projeperp.{1,1,1,0},Projeperp.{0,0,0,1},Projeperp.{1,0,0,1},Projeperp.{0,1,0,1},Projeperp.{0,0,1,1},Projeperp.{1,1,0,1},Projeperp.{1,0,1,1},Projeperp.{0,1,1,1},Projeperp.{1,1,1,1}};

PPolygk[k_]:={Projeperpk[k].{0,0,0,0},Projeperpk[k].{1,0,0,0},Projeperpk[k].{0,1,0,0},Projeperpk[k].{0,0,1,0},Projeperpk[k].{1,1,0,0},Projeperpk[k].{1,0,1,0},Projeperpk[k].{0,1,1,0},Projeperpk[k].{1,1,1,0},Projeperpk[k].{0,0,0,1},Projeperpk[k].{1,0,0,1},Projeperpk[k].{0,1,0,1},Projeperpk[k].{0,0,1,1},Projeperpk[k].{1,1,0,1},Projeperpk[k].{1,0,1,1},Projeperpk[k].{0,1,1,1},Projeperpk[k].{1,1,1,1}};

For[l=1,l<17,l++,AppendTo[PerPoly4,{(Pinvk[4].(PPolyg4[[l]]))[[3]],(Pinvk[4].(PPolyg[[l]]))[[4]]}]];

ListPlot[PointsExtr]

ConvexHullMesh[PerPoly3]

Prod[x_,y_]:=x[[1]]*y[[2]]-x[[2]]*y[[1]];

Bar[a_,b_,c_,x_]:={Prod[b-x,c-x]/Prod[b-a,c-a],Prod[c-x,a-x]/Prod[b-a,c-a],Prod[a-x,b-x]/Prod[b-a,c-a]};
EnvConv[a_,b_,c_,x_]:=Module[{bar=Bar[a,b,c,x]},bar[[1]]≥0 && bar[[2]]≥0 && bar[[3]]≥0];

(*Test pour approximant 3*)

Poly3:=PPolygk[3];

PerPoly3:={};
For[k=1,k<17,k++,AppendTo[PerPoly3,{(Pinvk[3].(Poly3[[k]]))[[3]],(Pinvk[3].(Poly3[[k]]))[[4]]}]];

ListPlot[PerPoly3]

PerPoly3

PointsExt3:={{0.`,0.7071078431372548`},{0.7071078431372548`,0.7071078431372548`},{1.2071078431372548`,0.2071078431372549`},{1.2071078431372548`,-0.5`},{0.7071078431372549`,-1.`},{0.`,-1.`},{-0.5`,-0.5`},{-0.5`,0.2071078431372549`}};

ListPlot[PointsExt3]

InPoly3[{q1_,q2_,q3_,q4_}]:=Module[{t,q={(Pinvk[3].(Projeperpk[3].{q1,q2,q3,q4}))[[3]],(Pinvk[3].(Projeperpk[3].{q1,q2,q3,q4}))[[4]]}},t=EnvConv[{0,0},PointsExt3[[1]],PointsExt3[[2]],q]||EnvConv[{0,0},PointsExt3[[2]],PointsExt3[[3]],q]||EnvConv[{0,0},PointsExt3[[3]],PointsExt3[[4]],q]||EnvConv[{0,0},PointsExt3[[4]],PointsExt3[[5]],q]||EnvConv[{0,0},PointsExt3[[5]],PointsExt3[[6]],q]||EnvConv[{0,0},PointsExt3[[6]],PointsExt3[[7]],q]||EnvConv[{0,0},PointsExt3[[7]],PointsExt3[[8]],q];t];

Pointsk3[l_,m1_,m2_,m3_,m4_]:=Module[{ll=l},Do[If[InPoly3[{q1,q2,q3,q4}],AppendTo[ll,{(Pinvk[3].(Projepark[3].{q1,q2,q3,q4}))[[1]],(Pinvk[3].(Projepark[3].{q1,q2,q3,q4}))[[2]]}]],{q1,0,m1},{q2,0,m2},{q3,0,m3},{q4,0,m4}];ll];
Voisinsk3[res_,l_]:=Module[{n=Length[l],d, r=res},Do[{d=Norm[l[[j]]-l[[jj]]];If[d==1 && j<jj ,AppendTo[r,{{(Pinvk[3].(Projepark[3].l[[j]]))[[1]],(Pinvk[3].(Projepark[3].l[[j]]))[[2]]},{(Pinvk[3].(Projepark[3].l[[jj]]))[[1]],(Pinvk[3].(Projepark[3].l[[jj]]))[[2]]}}]]},{j,1,n}, {jj,1,n}];r];

ListPlot[Pointsk3[{},2,4,4,4]]

PointsAuxk3[l_,m1_,m2_,m3_,m4_]:=Module[{ll=l},Do[If[InPoly3[{q1,q2,q3,q4}],AppendTo[ll,{q1,q2,q3,q4}]],{q1,-m1,m1},{q2,-m2,m2},{q3,-m3,m3},{q4,-m4,m4}];ll];

Ptaux2:=PointsAuxk3[{},2,2,2,2];

Ptsaux3:=PointsAuxk3[{},4,4,4,4];

Length[Ptaux2]

vois3:=Voisinsk3[{},Ptsaux3];

vois3v3:=Voisinsk3[{},Ptsaux2];
Length[Ptsaux3]

PointsPerk3[l_,m1_,m2_,m3_,m4_]:=Module[{ll=l},Do[If[InPoly3[{q1,q2,q3,q4}],AppendTo[ll,{(Pinvk[3].(Projeperpk[3].{q1,q2,q3,q4}))[[1]],(Pinvk[3].(Projeperpk[3].{q1,q2,q3,q4}))[[2]]}]],{q1,-m1,m1},{q2,-m2,m2},{q3,-m3,m3},{q4,-m4,m4}];ll];

ListPlot[PointsPerk3[{},17,17,17,17]]

(*GraphPlot[Table[vois3v2[[j,1]]->vois3v2[[j,2]],{j,1,585}]]

Points4[l_,m_]:=Module[{ll=l},Do[If[InCube[{q1,q2,q3,q4}],AppendTo[ll,{(Pinv.(Projepar.{q1,q2,q3,q4}))[[1]],(Pinv.(Projepar.{q1,q2,q3,q4}))[[2]]}]],{q1,0,m},{q2,0,m},{q3,0,m},{q4,0,m}];ll];

VoisinsOld[res_,l_]:=Module[{n=Length[l],d, r=res},Do[{d=Norm[l[[j]]-l[[jj]]];If[d==1 && j<jj,AppendTo[r,{{(Pinv.(Projepar.l[[j]]))[[1]],(Pinv.(Projepar.l[[j]]))[[2]]},{(Pinv.(Projepar.l[[jj]]))[[1]],(Pinv.(Projepar.l[[jj]]))[[2]]}}]]},{j,1,n}, {jj,1,n}];r];

Clear[voisaux,AuxPV,Voisins]

AuxPV[m_]:=Do[If[InCube[{q1,q2,q3,q4}],AppendTo[voisaux,{q1,q2,q3,q4}]],{q1,-m,m},{q2,-m,m},{q3,-m,m},{q4,-m,m}];

voisaux:={};

AuxPV[15];

Length[voisaux]

Tracer[l_]:=Module[{ll=Voisins[{},l]},GraphPlot[Table[ll[[j,1]]-> ll[[j,2]],{j,1,Length[ll]}]]];

Tracer[voisaux]