Small Networks
Small Networks
Format Conversions
Format Conversions
NetworkToList[g_]:=Module[{nodes},nodes=First/@g;Map[Position[nodes,#][[1,1]]&,Apply[List,Last[#]]&/@Apply[List,g],{2}]]
NodesToEdges[g_]:=Flatten[Partition[Sort[Sort/@(Flatten[Thread/@g]/.Rule->List)],1,2],1]
EdgesToNodes[g_]:=#[[1,1]]->#[[2]]&/@Transpose/@Partition[Sort[Join[g,Reverse/@g]],3]
AllNodes[g_]:=First/@g
NetworkToMatrix[g_]:=ReplacePart[Table[0,{Length[g]},{Length[g]}],1,Join[NodesToEdges[g],Reverse/@NodesToEdges[g]]]
Graphics to Networks (ReverseEngineer)
Graphics to Networks (ReverseEngineer)
ReverseEngineer[g_]:=Module[{gp,nn},gp=Union[Sort/@Flatten[Cases[g,Line[x_]:>Partition[x,2,1],∞],1]];nn=Union[Flatten[gp,1]];EdgesToNodes[Map[First[Flatten[Position[nn,#]]]&,gp,{2}]]]
ReverseEngineerNodes[g_]:=Module[{gp},gp=Union[Sort/@Flatten[Cases[g,Line[x_]:>Partition[x,2,1],∞],1]];Union[Flatten[gp,1]]]
Add rims around 2D networks
AddRim2D[g_]:=Graphics[Line/@Module[{gp,nnf,nnc,mid,ang},gp=Union[Sort/@Flatten[Cases[g,Line[x_]:>Partition[x,2,1],∞],1],SameTest->Equal];nnf=Flatten[gp,1];nn=Union[nnf,SameTest->Equal];nnc=Select[nn,(Count[nnf,#]<3)&];mid=Apply[Plus,nnc]/Length[nnc];ang=Apply[ArcTan,(#-mid)&/@nnc,{1}];nnc=Last/@Sort[Transpose[{ang,nnc}]];nnc=Append[nnc,First[nnc]];gp=Join[gp,Partition[nnc,2,1]]],AspectRatio->Automatic]
RimNodes2D[g_]:=Module[{gp,nnf,nnc,mid,ang},gp=Union[Sort/@Flatten[Cases[g,Line[x_]:>Partition[x,2,1],∞],1],SameTest->Equal];nnf=Flatten[gp,1];nn=Union[nnf,SameTest->Equal];Flatten[Position[nn,x_/;(Count[nnf,x]<3),1,Heads->False]]]
Random Networks
Random Networks
Dimensional Networks
Dimensional Networks
Spherical Networks
Spherical Networks
Tree Networks
Tree Networks
Properties of Networks
Properties of Networks
Graphics
Graphics
Embeddings
Embeddings
TrialMatrix[n_,d_]:=Table[Sum[,{k,d}],{i,n},{j,n}]
2
(x[i,k]-x[j,k])
FindEmbedding[g_,d_:2,wf_:(1&),s_:1234,opts___]:=Module[{n=Length[g],m=DistanceMatrix[g],c,vars,con,ans,ans2,ans3},c=Apply[Plus,Flatten[Map[wf,m,{2}](TrialMatrix[n,d]-m^2)]^2];vars=Flatten[Table[x[i,j],{i,2,n},{j,d}]];con=Table[x[1,i]->0,{i,d}];SeedRandom[s];ans=FindMinimum[Evaluate[c/.con],##,opts]&@@({#,Random[]}&/@vars);ans2=Prepend[Partition[vars/.Last[ans],d],Table[0,{d}]];ans3=Map[ans2[[#]]&,NodesToEdges[g],{-1}];{ans2,If[d==2,Graphics,Graphics3D][Line/@ans3,AspectRatio->Automatic]}]
EmbeddedMatrix[data_]:=Sqrt[Outer[Apply[Plus,(#1-#2)^2]&,data,data,1]]
EmbeddedDistances[g_,data_]:=Module[{gp},gp=NodesToEdges[g];Sqrt[Map[Apply[Plus,#^2]&,Apply[data[[#1]]-data[[#2]]&,gp,{1}]]]]