(* find out a sequence of PHYSICS to go from one state of the registers to another state *) module F = struct type state = int*int*int*int*int*int let success (s0,s1,s2,s3,d0,d1) = s0=1 (* s0=255 && (s1=2 || s2=2 || s3=2) && (d0=255 && 10<=d1 && d1<=254 || d1=255 && 10<=d0 && d0<=254) *) (* moves *) type move = int let move n (s0,s1,s2,s3,d0,d1) = assert (0 <= n && n <= 31); let sn = if n >= 16 then -16 + (n land 15) else n in let s0 = s0 + sn in let s0 = if s0 < 0 then s0 + 256 else if s0 > 255 then s0 - 256 else s0 in assert (0 <= s0 && s0 <= 255); (* extraction *) let l = if n land 1 > 0 then [d1] else [] in let l = if n land 2 > 0 then d0 :: l else l in let l = if n land 4 > 0 then s3 :: l else l in let l = if n land 8 > 0 then s2 :: l else l in let l = if n land 16 > 0 then s1 :: l else l in let l = s0 :: l in (* rotation *) let l = List.tl l @ [List.hd l] in (* new registers *) let s0,l = List.hd l, List.tl l in let s1,l = if n land 16 > 0 then List.hd l, List.tl l else s1,l in let s2,l = if n land 8 > 0 then List.hd l, List.tl l else s2,l in let s3,l = if n land 4 > 0 then List.hd l, List.tl l else s3,l in let d0,l = if n land 2 > 0 then List.hd l, List.tl l else d0,l in let d1,l = if n land 1 > 0 then List.hd l, List.tl l else d1,l in assert (l = []); (s0,s1,s2,s3,d0,d1) let moves st = List.map (fun n -> n, move n st) [1;2;3;4; (* 5;6;7;8; 9;10;11;12; 13;14;15;16; 17;18;19;20; 21;22;23;24; 25;26;27;28; *) 29;30;31;21] (* visited states are put in a hash table using function [mark] *) type marked_state = state let mark s = Some s end open F module S = Search.FunctionalIDS(F) open Format let s5 n =if n >= 16 then -16 + (n land 15) else n let () = let (s0,s1,s2,s3,d0,d1),ml = S.search (255,4,239,3,255,253) in printf "YES! (%d)@." (List.length ml); List.iter (fun p -> printf "PHYSICS %d;@." (s5 p)) ml; printf "%d,%d,%d,%d / %d,%d@." s0 s1 s2 s3 d0 d1