@Simon Fischer :)
SpekkensStates = {{1, 1, 0, 0}, {0, 0, 1, 1}, {1, 0, 1, 0}, {0, 1, 0,
1}, {0, 1, 1, 0}, {1, 0, 0, 1}};
GraphPlot[
Flatten[
Table[
{i -> j, j -> i},
{i, 1, Length[TensorProduct[SpekkensStates, SpekkensStates]]},
{j, i + 1, Length[TensorProduct[SpekkensStates, SpekkensStates]]}]
],
EdgeShapeFunction -> ({Thick, Arrowheads[0.05], Arrow[#1, 0.1]} &),
VertexLabels ->
Table[i -> ToString[SpekkensStates[[i]]], {i,
Length[SpekkensStates]}],
VertexSize -> Medium,
VertexStyle ->
Map[Hue[RandomReal[]] &,
Range[Length[TensorProduct[SpekkensStates, SpekkensStates]]]],
VertexCoordinates ->
Table[i -> RandomReal[{-1, 1}, 2], {i,
Length[TensorProduct[SpekkensStates, SpekkensStates]]}],
PlotRangePadding -> Scaled[0.05],
Epilog -> Inset[Style["Legend", 20], {-1.2, 1.2}],
AspectRatio -> 1
]
@Paul Borrill
@Paul Borrill tell us about your journey, across the Ethernet link looking at the Spekkens' knowledge balance principle and how it is applied in classical entanglement.
DynamicModule[
{
g0 = NearestNeighborGraph[
Position[ConstantArray[1, {16, 8}], 1],
{All, Sqrt[2]}],
g1,
selection = {5, 6}
},
Dynamic[
g1 = ResourceFunction["ToDirectedAcyclicGraph"][g0, {selection}];
Graph[
Rule[
RandomChoice[
VertexInComponent[g1, #, {1}]], #] & /@
Complement[VertexList[g1], {selection}],
VertexStyle -> Flatten[MapThread[Thread[#2 -> #1] &,
{
{RGBColor[0, 1, 0],
RGBColor[0, 0, 1],
RGBColor[1, 0, 0]},
Function[{valence},
Select[VertexList[g0],
VertexOutDegree[g0, #] == valence &]] /@ {3, 5, 8}
}]],
VertexCoordinates -> (# -> # & /@ VertexList[g1]),
EdgeStyle -> Directive[Gray, Arrowheads[0.03]],
ImageSize -> 800,
PerformanceGoal -> "Quality",
VertexShapeFunction -> (EventHandler[Disk[#1, Scaled[0.01]],
"MouseMoved" :> (selection = #2;
g1 = ResourceFunction["ToDirectedAcyclicGraph"][
g0, {selection}];)] &)]]]
