(*
Format for state:
{{L1, R1}, {L2, R2}, .....}

Extended format for state (included pre-GC node numbers):
{{{L1, R1}, {L2, R2}, ....}, {N1, N2, N3, ....}, Nmax}

Format for rule:
{depth, {{n1, n2, n3} -> {{1, 1}, {}}, {n1, n2, n3} -> {{{1, 1}, {2}}, ...},
	....}

*)


GetNeighborsList[list_, i_Integer, n_Integer] :=
	NestList[
		Union[Flatten[list[[#]]]]&, Union[ list[[i]] ], n-1]

GetNeighborsNumber[list_, i_Integer, n_Integer] :=
	(Length /@ GetNeighborsList[list, i, n])

RandomNet[tot_, valence_:2] :=
	Table[Random[Integer, {1, tot}], {tot}, {valence}]

CyclicNet[tot_] :=
	RotateRight[ Table[Mod[{i-1, i+1}, tot] + 1, {i, tot}] ]


DNEvolveStep[{depth_Integer, rules_List}, list_List] :=
	Block[{newnodenumber, newnodes}, Module[{curn, newn},
		newnodes = { };
		newnodenumber = Length[list];
		Join[ Table[
			DNEvolveStep0[
				Replace[GetNeighborsNumber[list, i, depth], rules],
					list, i],
				{i, Length[list]}], newnodes ] ] ]

GoPath[list_, i_, dexes_List] :=
	Fold[(list[[#1]][[#2]])&, i, dexes]

DNEvolveStep0[rule_, list_, i_] :=
	(DNEvolveStep00[#, list, i]& /@ rule)
	
DNEvolveStep00[rlist:{___Integer}, list_, i_] := GoPath[list, i, rlist]

DNEvolveStep00[{rll:{___Integer}, rlr:{___Integer}}, list_, i_] :=
	Module[{    },
		AppendTo[newnodes, {GoPath[list, i, rll], GoPath[list, i, rlr]}];
		++newnodenumber
	]

DNEvolveList[rlist_List, list_List, t_Integer] :=
	NestList[DNEvolveStep[rlist, #]&, list, t]

GCDNEvolveList[rlist_List, list_List, t_Integer] :=
	NestList[GC[DNEvolveStep[rlist, #]]&, list, t]



PDNEvolveList[rlist_List, {plist_List, list_List}, t_Integer] :=
	NestList[PDNEvolveStep[rlist, #]&, {plist, list}, t]

PDNEvolveListMM[rlist_List, {plist_List, list_List}, t_Integer] :=
	NestList[({Union[Flatten[#]], #}& 
		[PDNEvolveStep[rlist, #]])&, {plist, list}, t]

PGCDNEvolveList[rlist_List, {plist_List, list_List}, t_Integer] :=
	NestList[Block[
		{newnodemap = {}},
			PGC[{PDNEvolveStep[rlist, #], 1}]]&, {plist, list}, t]

PDNEvolveStep[{depth_Integer, rules_List}, {plist_List, list_List}] :=
	Block[{newnodenumber, newnodes}, Module[{curn, newn},
		newnodes = { };
		newnodenumber = Length[list];
		Join[ Table[
			PDNEvolveStep0[
				Replace[GetNeighborsNumber[list, i, depth], rules],
					list, i],
				{i, Length[list]}], newnodes ] ] ]

PDNEvolveStep0[rule_, list_, i_] :=
	(PDNEvolveStep00[#, list, i]& /@ rule)
	
PDNEvolveStep00[rlist:{___Integer}, list_, i_] := GoPath[list, i, rlist]

PDNEvolveStep00[{rll:{___Integer}, rlr:{___Integer}}, list_, i_] :=
	Module[{    },
		AppendTo[newnodes, {GoPath[list, i, rll], GoPath[list, i, rlr]}];
		AppendTo[newnodemap, {i, newnodenumber+1}];
		++newnodenumber
	]

PGC[{list_List, na_Integer}] :=
	Block[{keeps, pl, nnm},
		keeps = { };
		PGC0[list, na];
		nnm = Last /@ newnodemap;
		pl = Sort[ 
				If[MemberQ[nnm, #], Cases[newnodemap, {_, #}][[1]], {#, #}]& /@
			keeps ];
		keeps = Last /@ pl;
		pl = First /@ pl;
		{pl, Map[Position[keeps, #, 1, 1][[1, 1]]&, list[[keeps]], {2}]}	
	]




GC[list_List] :=
	Block[{keeps},
		keeps = { };
		GC0[list, 1];
		keeps = Sort[keeps] ;
		Map[Position[keeps, #, 1, 1][[1, 1]]&, list[[keeps]], {2}]	
	]

GC0[list_, i_] :=
	If[MemberQ[keeps, i], Null,
		AppendTo[keeps, i];
		GC0[list, list[[i, 1]]];
		GC0[list, list[[i, 2]]]]

DNXEvolveList[rlist_List, list_List, t_Integer] :=
	NestList[DNXEvolveStep[rlist, #]&, 
				{list, Range[Length[list]], Length[list]},
							t]

GCDNXEvolveList[rlist_List, list_List, t_Integer] :=
	NestList[GCX[ DNXEvolveStep[rlist, #] ]&, 
				{list, Range[Length[list]], Length[list]},
							t]



DNXEvolveStep[{depth_Integer, rules_List}, 
														{list_List, nlist_List, nmax_Integer}] :=
	Block[{newnodenumber, newnodes}, Module[{curn, newn},
		newnodes = { };
		newnodenumber = Length[list];
		{Join[ Table[
			DNEvolveStep0[
				Replace[GetNeighborsNumber[list, i, depth], rules],
					list, i],
				{i, Length[list]}], newnodes ],
			Join[nlist, nmax+Range[Length[newnodes]]],
			nmax+Length[newnodes]} ] ]


GCX[{list_List, nlist_List, nmax_Integer}] :=
	Block[{keeps},
		keeps = { };
		GC0[list, 1];
		keeps = Sort[keeps] ;
		{Map[Position[keeps, #, 1, 1][[1, 1]]&, list[[keeps]], {2}],
				nlist[[keeps]], nmax}
	]

		
		

DNGraphic[history_] :=
	Module[{xmax},
	Graphics[ Table[xmax = Length[history[[y]]];
			Table[{Line[{{x/xmax, -y}, {history[[y, x, 1]]/xmax, -y-1}}],
		Line[{{x/xmax, -y}, {history[[y, x, 2]]/xmax, -y-1}}]}, 
			{x, xmax}],
			{y, Length[history]}]] ] 

RandomDNRule[depth_Integer, newprob_] :=
	{depth, Flatten[ Array[({##} -> 1 + Table[If[Random[] < newprob,
		Table[Table[Random[Integer], 
			{Random[Integer, {0, 2}]}], {2}],
		Table[Random[Integer], 
			{Random[Integer, {0, 3}]}]], 
					{2}])& , 
			Table[2^i, {i, depth}]]] }



								
Differences[list_List] := Apply[(#2 - #1)&,
	Partition[list, 2, 1], {1}]	

Ratios[list_List] := Apply[(N[#2/#1])&,
	Partition[list, 2, 1], {1}]


$NodeLabelFont = {"Univers-LightOblique", 5}

(**** ToNetwork[list_List] :=
	Network[Join[
				{Node[1, NodeLabelFont->$NodeLabelFont,
					NodeSize->3, NodeStyle->Annulus]},
				Table[Node[i,
				NodeLabelFont->$NodeLabelFont
						], {i, 2, Length[list]}],
			Table[Arc[{i, #}]& /@ list[[i]], {i, Length[list]}]],
					NodeLabel->Automatic,
					(* NodeLabelFont->$NodeLabelFont, *)
					NodeLabelAngle->.5,  (* should be Automatic *)
					ArcStyle->Circle,
					ArcCircleHeight->0.1,
					PlotRange->All]  *****)

ToNetworkX[{list_List, nlist_List, _Integer}] :=
	Network[Join[
				{Node[1, NodeLabelFont->$NodeLabelFont,
					NodeSize->2.8, NodeStyle->Annulus, NodeAnnulusRatio->.5,
					NodeColor->{GrayLevel[0], GrayLevel[.5]}, NodeLabel->1]},
				Table[Node[i,
				NodeLabelFont->$NodeLabelFont,
				NodeLabel->nlist[[i]]
						], {i, 2, Length[list]}],
			Table[Arc[{i, list[[i, j]]},
					ArcLabel->Switch[j, 1, "p", 2, "q"],
					ArcCircleHeight->If[j == 2 && list[[i, 2]] == list[[i, 1]], .2, .1],
					ArcLabelFont->$NodeLabelFont], 
							{i, Length[list]}, {j, 2}]],
					(* NodeLabelFont->$NodeLabelFont, *)
					NodeLabelAngle->.5,  (* should be Automatic *)
					ArcStyle->Circle,
					ArcCircleHeight->0.1,
					PlotRange->All]



ToGridNetwork[list_List, {xmax_, ymax_}] :=
	Network[Join[
				{Node[1, NodeLabelFont->$NodeLabelFont,
					NodeSize->3, NodeStyle->Annulus]},
				Table[Node[i,
				NodeLabelFont->$NodeLabelFont
						], {i, 2, Length[list]}],
			Table[Arc[{i, #}]& /@ list[[i]], {i, Length[list]}]],
					NodeLabel->Automatic,
					(* NodeLabelFont->$NodeLabelFont, *)
					NodeLabelAngle->.5,  (* should be Automatic *)
					ArcStyle->Circle,
					ArcCircleHeight->0.1,
					PlotRange->All]


$PhredBase = "NetworkDynamics/PhredTmp/"

WritePhredSequence[name_String, list_List] :=
	MapIndexed[
		WriteNetwork[$PhredBase <> name <> "." <> ToString[First[#2]],
			#]&, list ]

ReadPhredSequence[name_String, {n1_Integer, n2_Integer}] :=
	GraphicsArray[ List /@ Table[NetworkGraphics[
		ReadNetwork[$PhredBase <> name <> "." <> ToString[i]]],
			{i, n1, n2}] ]

ReadPhredSequence[name_String, n_Integer] :=
	ReadPhredSequence[name, {1, n}]


(* Exhaustive search tools *)

DNAllRule[code_Integer] :=
	Module[{dd},
		dd = IntegerDigits[code, 6, 4];
		{1, Table[{i} -> Table[{{1}, {2}, {{1}, {1}}, 
			{{1}, {2}}, {{2}, {1}}, {{2}, {2}}}[[1 + dd[[1 + 2(i-1) + (j-1)]] ]],
					{j, 2}], {i, 2}]}]

(* Total of 6^4 cases *)

(*******
 Sequential dynamic networks 
********)

(*
State:
{{{l1, r1}, {l2, r2}, ...}, nactive}

PState:
{{successors of nodes on prev step}, newstate}

rules:
{depth, {{n1, n2, ..} -> { {{1, 1}, {}},  2 (* active node *) }, ...} }

*)

SDNEvolveStep[{depth_Integer, rules_List}, {list_List, na_Integer}] :=
	Block[{newnodenumber, newnodes}, Module[{nrule, nap},
		newnodes = { };
		newnodenumber = Length[list];
		{nrule, nap} = Replace[GetNeighborsNumber[list, na, depth], rules];
		{Join[
			ReplacePart[list, SDNEvolveStep0[
				nrule, list, na], na], newnodes ], list[[na, nap]]} ] ]

SDNEvolveStep0[rule_, list_, i_] :=
	(SDNEvolveStep00[#, list, i]& /@ rule)
	
SDNEvolveStep00[rlist:{___Integer}, list_, i_] := GoPath[list, i, rlist]

SDNEvolveStep00[{rll:{___Integer}, rlr:{___Integer}}, list_, i_] :=
	Module[{    },
		AppendTo[newnodes, {GoPath[list, i, rll], GoPath[list, i, rlr]}];
		++newnodenumber
	]

SDNEvolveList[rlist_List, list:{_List, _Integer}, t_Integer] :=
	NestList[SDNEvolveStep[rlist, #]&, list, t]

SGCDNEvolveList[rlist_List, list:{_List, _Integer}, t_Integer] :=
	NestList[SGC[ SDNEvolveStep[rlist, #] ]&, list, t]

SGC[{list_List, na_Integer}] :=
	Block[{keeps},
		keeps = { };
		GC0[list, na];
		keeps = Sort[keeps] ;
		{Map[Position[keeps, #, 1, 1][[1, 1]]&, list[[keeps]], {2}],
				Position[keeps, na, 1, 1][[1, 1]]}	
	]


RandomSDNRule[depth_Integer, newprob_] :=
	{depth, Flatten[ Array[({##} -> {1 + Table[If[Random[] < newprob,
		Table[Table[Random[Integer], 
			{Random[Integer, {0, 2}]}], {2}],
		Table[Random[Integer], 
			{Random[Integer, {0, 3}]}]], 
					{2}], Random[Integer, {1, 2}]})& , 
			Table[2^i, {i, depth}]]] }

ToNetworkS[{list_List, na_Integer}] :=
	Network[Join[
			Table[If[i != na, 
				Node[i],
				 Node[i, NodeSize->2.8, NodeStyle->Annulus, NodeAnnulusRatio->.5,
					NodeColor->{GrayLevel[0], GrayLevel[.5]}]
						], {i, Length[list]}],
			Table[Arc[{i, list[[i, j]]},
					ArcLabel->Switch[j, 1, "p", 2, "q"],
					ArcCircleHeight->If[j == 2 && list[[i, 2]] == list[[i, 1]], .2, .1],
					ArcLabelFont->$NodeLabelFont], 
							{i, Length[list]}, {j, 2}]],
					(* NodeLabelFont->$NodeLabelFont, *)
					NodeLabelAngle->.5,  (* should be Automatic *)
					ArcStyle->Circle,
					ArcCircleHeight->0.1,
					PlotRange->All]



PSDNEvolveStep[{depth_Integer, rules_List}, {plist_List,
				list_List, na_Integer}] :=
	Block[{newnodenumber, newnodes}, Module[{nrule, nap},
		newnodes = { };
		newnodenumber = Length[list];
		{nrule, nap} = Replace[GetNeighborsNumber[list, na, depth], rules];
		{Join[
			ReplacePart[list, PSDNEvolveStep0[
				nrule, list, na], na], newnodes ], list[[na, nap]]} ] ]

PSDNEvolveStep0[rule_, list_, i_] :=
	(PSDNEvolveStep00[#, list, i]& /@ rule)
	
PSDNEvolveStep00[rlist:{___Integer}, list_, i_] := GoPath[list, i, rlist]

PSDNEvolveStep00[{rll:{___Integer}, rlr:{___Integer}}, list_, i_] :=
	Module[{    },
		AppendTo[newnodes, {GoPath[list, i, rll], GoPath[list, i, rlr]}];
		AppendTo[newnodemap, {i, newnodenumber+1}];
		++newnodenumber
	]

PSDNEvolveList[rlist_List, list:{(* to add *) _List, _Integer}, t_Integer] :=
	NestList[PSDNEvolveStep[rlist, #]&, list, t]

PSGCDNEvolveList[rlist_List, list:{_List, _List, _Integer}, t_Integer] :=
	NestList[
		Block[{newnodemap = {}},
				PSGC[ PSDNEvolveStep[rlist, #] ]]&, 
						list, t]

PSGC[{list_List, na_Integer}] :=
	Block[{keeps, pl, nnm},
		keeps = { };
		PGC0[list, na];
		nnm = Last /@ newnodemap;
		pl = Sort[ 
				If[MemberQ[nnm, #], Cases[newnodemap, {_, #}][[1]], {#, #}]& /@
			keeps ];
		keeps = Last /@ pl;
		pl = First /@ pl;
		{pl, Map[Position[keeps, #, 1, 1][[1, 1]]&, list[[keeps]], {2}],
				Position[keeps, na, 1, 1][[1, 1]]}	
	]

PGC0[list_, i_] :=
	If[MemberQ[keeps, i], Null,
		AppendTo[keeps, i];
		PGC0[list, list[[i, 1]]];
		PGC0[list, list[[i, 2]]]]


(*** 1D display mechanisms ***)

DNLineDisplayStep[{plist_, list_}, t_Integer] :=
		Module[{   },
				{{GrayLevel[0], AbsoluteThickness[.5], 
						MapIndexed[Line[{{First[#2], -t}, {#1, 1-t}}]&,
								plist]},
				{GrayLevel[0], AbsolutePointSize[.5],
						Point[{#, -t}]& /@ Range[Length[list]]},
				{ }}]

DNLineDisplay[history_] :=
	Surround[ Graphics[MapIndexed[DNLineDisplayStep[#, First[#2]]&, history],
			AspectRatio->Automatic, PlotRange->All] ]

SDNLineDisplayStep[{plist_, list_, na_}, t_Integer] :=
		Module[{   },
				{{GrayLevel[0], AbsoluteThickness[.5], 
						MapIndexed[Line[{{First[#2], -t}, {#1, 1-t}}]&,
								plist]},
				{GrayLevel[0], AbsolutePointSize[.5],
						Point[{#, -t}]& /@ Range[Length[list]]},
				If[Length[plist] == 0, {}, {GrayLevel[0], AbsoluteThickness[3],
						Line[{{na, -t}, {plist[[na]], 1-t}}]}],
				{ }}]

(* should show the links along which the active node travels in dark black *)

SDNLineDisplay[history_] :=
	Surround[ Graphics[MapIndexed[SDNLineDisplayStep[#, First[#2]]&, history],
			AspectRatio->Automatic, PlotRange->All] ]



DNCircleDisplay[list_, t_Integer] :=
		MapIndexed[ {DNCD0[First[#], First[#2], 1, t, Length[list]],
			DNCD0[Last[#], First[#2], -1, t, Length[list]]}&, list]

DNCD0[dst_, src_, dir_, t_, len_] :=
	If[dst==src, Circle[{src, -t + dir*1/6}, 1/6],
			DNCD00[{(src+dst)/2, -t}, N[Abs[{(src-dst)/2, .9 Sqrt[(src-dst)/len]}]],
					dir, If[dst > src, 1, -1]]]

DNCD00[{x0_, y0_}, {rx_, ry_}, dir_, adir_] :=
	{Circle[{x0, y0}, {rx, ry}, If[dir > 0, {0, Pi}, {Pi, 2Pi}]],
			Line[{{x0 - 0.1 adir, y0 + dir ry + 0.06}, {x0, y0 + dir ry}, 
					{x0 - 0.1 adir, y0 + dir ry - 0.06}}]}
	

DNDisplay[history_] :=
	Surround[ Graphics[
		{
		{GrayLevel[0.5], AbsoluteThickness[1], 
						MapIndexed[Function[{xlist, t}, MapIndexed[
							Line[{{First[#2], -2 First[t]}, {#1, 2 - 2 First[t]}}]&,
									First[xlist]]], history]},
		{GrayLevel[0], AbsoluteThickness[.25],
				MapIndexed[ DNCircleDisplay[Last[#], 2 First[#2]]&, history]},
		{GrayLevel[0], AbsolutePointSize[1.5],
					Table[Point[{x, -2 y}], {y, 1, Length[history]},
							{x, 1, Length[history[[y, 2]]]}]}},
			AspectRatio->Automatic, PlotRange->{{0.5, 0.5 + Max[Length[#[[2]]]& /@ 
					history]}, All}] ]


SDNDisplay[history_] :=
	Surround[ Graphics[
		{
		{GrayLevel[0.5], AbsoluteThickness[1], 
						MapIndexed[Function[{xlist, t}, MapIndexed[
							Line[{{First[#2], -2 First[t]}, {#1, 2 - 2 First[t]}}]&,
									First[xlist]]], history]},
		{GrayLevel[0], AbsoluteThickness[.25],
				MapIndexed[ DNCircleDisplay[#[[2]], 2 First[#2]]&, history]},
		{GrayLevel[0], AbsolutePointSize[1.5],
					Table[Point[{x, -2 y}], {y, 1, Length[history]},
							{x, 1, Length[history[[y, 2]]]}]},
		{GrayLevel[0], AbsolutePointSize[3],
					MapIndexed[Point[{Last[#], -2 First[#2]}]&, history]},
		{GrayLevel[0], AbsoluteThickness[1],
				Table[ DNCD0[history[[y+1, 1, history[[y+1, 3]]]], history[[y, 3]],
						 If[history[[y, 2, history[[y, 3]], 1]] ==
									history[[y+1, 1, history[[y+1, 3]]]], 1, -1], 
											2y, Length[history[[y, 2]]]], 
								{y, 1, Length[history]-1}],
				Table[Line[{{history[[y, 3]], -2 y}, {history[[y, 1,
   				history[[y, 3]]]], 2-2y}}], {y, 2, Length[history]}]}},
			AspectRatio->Automatic, PlotRange->{{0.5, 0.5 + Max[Length[#[[2]]]& /@ 
					history]}, All}] ]


Net1DDisplay[list_] :=
	Surround[Graphics[
		{{GrayLevel[0], AbsoluteThickness[.25], DNCircleDisplay[list, 0]},
			{GrayLevel[0], AbsolutePointSize[1.5], Point[{#, 0}]& /@ 
					Range[Length[list]]}},
						AspectRatio->Automatic, PlotRange->All]]

Net1DDisplayR[list_] :=
	Graphics[
		{{GrayLevel[0], AbsoluteThickness[.25], DNCircleDisplay[list, 0]},
			{GrayLevel[0], AbsolutePointSize[1.5], Point[{#, 0}]& /@ 
					Range[Length[list]]}},
						AspectRatio->Automatic, PlotRange->All]



DNRuleDisplay[rule : {1, _}] := 
  FramedGraphicsRow[{DNRuleDisplay0[
        PDNEvolveRuleList[rule, {{1, 0}, {{2, 2}, {2, 2}}}]], 
      DNRuleDisplay0[
        PDNEvolveRuleList[rule, {{1, 0, 0}, {{2, 3}, {2, 2}, {3, 3}}}]]}]
        
        

PDNEvolveRuleStep[{depth_Integer, rules_List}, {plist_List, list_List}] :=
	Block[{newnodenumber, newnodes}, Module[{curn, newn},
		newnodes = { };
		newnodenumber = Length[list];
		Join[
			ReplacePart[list, PDNEvolveStep0[
				Replace[GetNeighborsNumber[list, 1, depth], rules], list, 1], 1], 
					newnodes ] ] ]

PDNEvolveRuleList[rlist_List, {plist_List, list_List}] :=
	NestList[Block[
		{newnodemap = {}},
			PGC[{PDNEvolveRuleStep[rlist, #], 1}]]&, {plist, list}, 1]

DNRuleDisplay0[history_] := 
  Graphics[{{GrayLevel[0.5], AbsoluteThickness[1], 
        MapIndexed[Line[{{First[#2], -4}, {#1, -2}}] &, 
          history[[2, 1]]]}, {GrayLevel[0], AbsoluteThickness[0.25], 
        MapIndexed[DNCircleRuleDisplay[Last[#1], 2 First[#2], First[#1]] &, 
          history]}, {GrayLevel[0], AbsolutePointSize[1.5], 
        Table[If[history[[y, 1, x]] == 1, 
            Disk[{x, -2 y}, 
              0.1], {Disk[{x, -2 y}, 0.1], {GrayLevel[1], 
                Disk[{x, -2 y}, 0.08]}}], {y, 1, Length[history]}, {x, 1, 
            Length[history[[y, 2]]]}]}}, AspectRatio -> Automatic, 
    PlotRange -> {{0.35, 
          0.6 + Max[(Length[#1[[2]]] &) /@ history]}, {-5.15, -.75}}]
          
          

DNCircleRuleDisplay[list_, t_Integer, plist_List] :=
		MapIndexed[ If[plist[[First[#2]]]==1,
			{DNCD0[First[#], First[#2], 1, t, Length[list]],
			DNCD0[Last[#], First[#2], -1, t, Length[list]]}, {}]&, list]