formal_lp/hypermap/computations/informal_computations.hl

   1 module Lp_informal_computations = struct
   2
   3 let take n = fst o chop_list n;;
   4 let drop n = snd o chop_list n;;
   5
   6 let rec rotateL i xs =
   7   if i=0 then xs
   8   else match xs with
   9     | x::xss -> rotateL ((i-1) mod length xs) (xss @ [x])
  10     | [] -> [];;
  11
  12 let rotateR i = rotateL (-i);;
  13
  14 let list_pairs list =
  15   let h = hd list in
  16   let rec pairs list =
  17     match list with
  18       | [] -> []
  19       | [h1] -> [h1, h]
  20       | h1 :: h2 :: t -> (h1,h2) :: pairs (h2 :: t) in
  21     pairs list;;
  22
  23
  24 let split_list list dart =
  25   let split_face f =
  26     if length f <= 3 then
  27       [f]
  28     else
  29       let t3, _ = chop_list 3 f in
  30       let _, d2 = chop_list 2 f in
  31         [t3; hd t3 :: d2] in
  32
  33   let rec split list =
  34     match list with
  35       | [] -> []
  36       | f :: t ->
  37           let pairs = list_pairs f in
  38             if mem dart pairs then
  39               let i = index dart pairs in
  40                 split_face (rotateR 1 (rotateL i f)) @ t
  41             else
  42               f :: split t in
  43     split list;;
  44
  45 end;;