fork download 
  1. buildInitialState[n_,m_]:=If[And[n>1,m>1],
  2. 	Table[Table[{0,0},{i,n}],{j,m}]//
  3. 		ReplacePart[#,{1,1,1}->"a"]&//
  4. 		{#,0}&,
  5. 	-1];
  6.  
  7.  
  8. painterAutomaton[state_,action_]:=Module[{
  9. 	checkBoundary,checkDry,checkWhite,
  10. 	pos,step,dir,act,
  11. 	automatonpos,newpos},
  12.  
  13. 	(* Function *)
  14. 	checkBoundary[pos_,newpos_]:=Dimensions[pos]//
  15. 			And[0<newpos[[1]]<=#[[1]],0<newpos[[2]]<=#[[2]]]&;
  16.  
  17. 	checkDry[pos_,newpos_]:=Extract[pos,newpos+{0,0,1}]<=1;
  18.  
  19. 	checkWhite[pos_,newpos_]:=Extract[pos,newpos+{0,0,1}]==0;
  20.  
  21. 	(* Data & Parameter *)
  22. 	{pos,step}=state;
  23.  
  24. 	{dir,act}=action;
  25.  
  26. 	(* Analysis *)
  27. 	automatonpos=pos//
  28. 		Position[#,"a"]&//
  29. 		#[[1]]&;
  30.  
  31. 	newpos=automatonpos//
  32. 		{#[[1]],#[[2]],#[[3]]}+
  33. 			Which[
  34. 				dir=="u",{-1,0,0},
  35. 				dir=="d",{1,0,0},
  36. 				dir=="c",{0,0,0},
  37. 				dir=="r",{0,1,0},
  38. 				dir=="l",{0,-1,0},
  39. 				True,{}]&;
  40.  
  41. 	(* Results *)
  42. 	Which[
  43. 		act=="mv",
  44. 			If[And[checkBoundary[pos,newpos],checkDry[pos,newpos]],
  45. 				ReplacePart[pos,automatonpos->0]//
  46. 					ReplacePart[#,newpos->"a"]&//
  47. 				{#,step}&,
  48. 				"Stop"],
  49. 		And[act=="pa",dir!="c"],
  50. 			If[And[checkBoundary[pos,newpos],checkWhite[pos,newpos]],
  51. 				ReplacePart[pos,newpos+{0,0,1}->6]//
  52. 					{#,step}&,
  53. 				"Stop"],
  54. 		True,
  55. 			"Stop"]
  56. ];
  57.  
  58.  
  59. mapOneStep[states_]:=Module[{oneStep,changeState},
  60.  
  61. 	(* Function *)
  62. 	oneStep[state_]:=Module[{dir,act,possibleaction,newstate},
  63.  
  64. 		dir={"u","d","c","r","l"};
  65.  
  66. 		act={"mv","pa"};
  67.  
  68. 		possibleaction={dir,act}//
  69. 			Outer[List,#[[1]],#[[2]]]&//
  70. 			Flatten[#,1]&;
  71.  
  72. 		newstate=state//
  73. 			changeState;
  74.  
  75. 		possibleaction//
  76. 			Map[painterAutomaton[newstate,#]&,#]&//
  77. 			Select[#,Not[AtomQ[#]]&]&
  78. 	];
  79.  
  80. 	changeState[state_]:=Module[{pos,step},
  81.  
  82. 		{pos,step}=state;
  83.  
  84. 		pos//
  85. 			Map[Map[If[#[[2]]>1,
  86. 				{#[[1]],#[[2]]-1},
  87. 				#]&,#]&,#]&//
  88. 			{#,step+1}&
  89. 	];
  90.  
  91. 	(* Results *)
  92. 	states//
  93. 		ParallelMap[oneStep,#]&//
  94. 		Flatten[#,1]&
  95. ];
  96.  
  97.  
  98. allPaintedMemberQ[states_]:=Module[{allPaintedQ},
  99.  
  100. 	(* Function *)
  101. 	allPaintedQ[state_]:=state//
  102. 		#[[1]]&//
  103. 		Flatten[#,1]&//
  104. 		Map[#[[2]]&,#]&//
  105. 		Map[#>=1&,#]&//
  106. 		Apply[And,#]&;
  107.  
  108. 	(* Results *)
  109. 	states//
  110. 		Map[allPaintedQ,#]&//
  111. 		Apply[Or,#]&
  112. ];
  113.  
  114.  
  115. minStepToPaintAll[n_,m_]:=Module[{initialstate},
  116.  
  117. 	(* Data & Parameter *)
  118. 	initialstate=buildInitialState[n,m];
  119.  
  120. 	(* Results *)
  121. 	If[ListQ[initialstate],
  122. 		NestWhile[mapOneStep,{initialstate},Not[allPaintedMemberQ[#]]&]//
  123. 			#[[1,2]]&,
  124. 		-1]
  125. ];
  126.  
Not running #stdin #stdout 0s 0KB
comments (?)
stdin 
minStepToPaintAll[3, 2]
stdout 
Standard output is empty
https://ideone.com/g6SiVM
language:
Text (text 6.10)
created:
10 years ago
visibility:
public

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!