In[]:=
Quit
In[]:=
(*deployswithcanonicalname*)deploy:=Module[{notebookFn,parentDir,cloudFn,result},Print[DateString[]];notebookFn=FileNameSplit[NotebookFileName[]][[-1]];parentDir=FileNameSplit[NotebookFileName[]][[-2]];cloudFn=parentDir~StringJoin~"/"~StringJoin~notebookFn;result=CloudDeploy[SelectedNotebook[],CloudObject[cloudFn],Permissions"Public",SourceLinkNone];Print["Uploading to ",cloudFn];result];deploy
Sat 17 Sep 2022 21:02:59
In[]:=
On[Assert];(*simplexvisualizationfromhttps://mathematica.stackexchange.com/questions/138808/plotting-a-2d-slice-of-a-3d-function*)Clear[x,y];kk=Array[k,6];mat=Partition[kk,2];bb=Array[b,3];source={{-1/Sqrt[2],0},{1/Sqrt[2],0},{0,Sqrt[3/2]}};target={{1,0,0},{0,1,0},{0,0,1}};eqs=Table[mat.source[[i]]+bb==target[[i]],{i,3}];sol=First@Solve[eqs,kk~Join~bb];{mat0,bb0}={mat,bb}/.sol;imat0=PseudoInverse[mat0];unmap[point_]:=imat0.(point-bb0);expr=mat0.{x,y}+bb0;reg=ImplicitRegion[Reduce[Thread[expr>0]],{x,y}];val=;Assert[dist<=1];y=ConstantArray[1/d,d];ii=IdentityMatrix[d];projector=(ii-PseudoInverse[{y}].{y});planeProject[x_]:=x.projector+y;sphereProject[x_]:=dist*Normalize[x];If[targetAccuracy<1,NestWhile[planeProject[sphereProject[#]]&,x0,Abs[Norm[#]-dist]>targetAccuracy&],Nest[planeProject[sphereProject[#]]&,x0,100]];d=3;pointsFull=project[#,0.9]&/@RandomVariate[NormalDistribution[],{100,d}];points=Select[pointsFull,Min[#]>=0&];Print["Efficiency ",N@Length[points]/Length[pointsFull]];plot3=ListPlot[unmap/@pointsFull];Show[plot2,plot1,plot3]
Total[]
;plot1=RegionPlot[reg,PlotStyle->None];plot2=ContourPlot[val,{x,y}∈reg,AspectRatio->Automatic,PlotPoints->10,ContourShading->None];project[x0_,dist_]:=Module{},targetAccuracy=1;targetAccuracy=0.001;d=Length[x0];Assertdist>2
expr
1
d
Efficiency 0.14
Out[]=
