DouKaku?

(*範囲指定fold  x.(pos)からlen幅  はみ出し分はループ*)
let loop_fold_left_in f acc x pos len =
  let alen = Array.length x in
  let pos = if -alen<=pos && pos<0 then alen+pos else pos in
  let r,co = ref acc, ref 0 in
  
  for i = pos to pos+len-1 do
    if (i - !co)>=alen then co:=!co+alen;
    r := f !r (Array.get x (i - !co));
  done; !r;;

(*arr.(xpos).(ypos)中心の3*3マスでfがtrueとなる値の数*)
let count9 f arr xpos ypos =
  loop_fold_left_in (fun accx y -> 
    loop_fold_left_in (fun accy z -> 
      if f z then accy+1 else accy
    ) 0 y (ypos-1) 3 + accx
  ) 0 arr (xpos-1) 3 ;;

let mapi f arr =
  Array.init (Array.length arr) (fun i ->
    Array.init (Array.length arr.(i)) (fun j -> f i j arr.(i).(j))
  );;

(* t:生の値 f:死の値 arr:二次元array *)
let next t f arr =
  mapi (fun i j b -> 
    if j=0 then print_newline ();
    Printf.printf "[%c]" (if b=t then '*' else ' ');
    
    let num = count9 ((=) t) arr i j in
    if (b=t) then 
      if (num=3 || num=4) then t else f
    else 
      if (num=3) then t else f
  ) arr;;

let rec preview t f arr n =
  let rec loop arr i =
    if n<i then () else (
      Printf.printf "\nt=%d" i;
      loop (next t f arr) (i+1)
    )
  in loop arr 0;;
  
(*使用例
    preview 1 0 
      [|[|0; 0; 0; 0; 0|];
        [|0; 0; 1; 0; 0|];
        [|0; 0; 1; 0; 0|];
        [|0; 0; 1; 0; 0|];
        [|0; 0; 0; 0; 0|]|] 5;;
*)

let most = 0x400
let size = 10
  
let exist num pos = num land pos != 0
let i_of_b f = if f then 1 else 0
  
(* 左右端ループ対策 *)
let ring num = num lor (num lsl size) lor (num lsr size)
  
let rec update_line a b c pos =
  if pos = 1 then
    0
  else
    let count num p =
      i_of_b (exist num p) + i_of_b (exist num (p lsr 1)) + i_of_b (exist num (p lsl 1)) in
    let alive = count a pos + count b pos + count c pos in
      if alive = 3 || alive = 4 && exist b pos then
        pos + update_line a b c (pos lsr 1)
      else
        update_line a b c (pos lsr 1)
          
let rec update_field = function
    []          -> []
  | _::[]       -> []
  | _::_::[]    -> []
  | a::b::c::xs -> ring (update_line a b c most) :: update_field (b::c::xs)
      
let rec mk_line n =
  if n <= 0 then 0 else (i_of_b (Random.int 10 < 3) + mk_line (n-1)) lsl 1
    
let rec mk_field n =
  if n <= 0 then [] else ring (mk_line size) :: mk_field (n-1)
    
let rec print_field = function
    []    -> ()
  | x::xs ->
      for i = 0 to size-1 do
        if x land (most lsr i) != 0 then
          print_string "[*]"
        else
          print_string "[ ]";
      done;
      print_string "\n";
      print_field xs
        
let rec main_loop n fld =
  print_string ("t=" ^ string_of_int n ^ "\n");
  print_field fld;
  if String.compare (read_line ()) "exit" != 0 then
    (* 上下端ループ対策 *)
    let fld_ = List.concat [[List.nth fld 9]; fld; [List.hd fld]] in
      main_loop (n+1) (update_field fld_)
        
let () =
  Random.self_init ();
  main_loop 0 (mk_field size)