Commits

Yaron Minsky  committed 632a5d6

various updates

  • Participants
  • Parent commits a66813e

Comments (0)

Files changed (14)

File ocaml/.merlin

+EXT nonrec
 S .
 B _build
 PKG core
 PKG async
-EXT nonrec
 FLG -w -4-33-40-41-42-43-34-44

File ocaml/Makefile

-all: example.native experiments.native
+all: example.native example.byte
 
 FORCE:
 	true

File ocaml/branch.ml

+open Core.Std
+include Private_int.M
+
+include Pretty_printer.Register (struct
+    type z = t
+    type t = z
+    let module_name = "Branch"
+    let to_string = to_string
+  end)

File ocaml/branch.mli

+include Private_int.S

File ocaml/common.ml

 open Core.Std
 
-(* The id of a given branch *)
-module Branch : Private_int.S = Private_int.M
-(* A strand identifier on the interval *)
-module Strand : Private_int.S = Private_int.M
+let strand = Strand.of_int
+let branch = Branch.of_int
 
 let sexp_print conv v =
   v |> conv |> Sexp.to_string_hum |> print_endline

File ocaml/example.ml

 open Core.Std
 open Common
 
-let iet =
-  Iet.create_simple
-    { top = [0;1;2;0]; bot = [3;2;4;3;1;4] }
-    ~widths:[6;2;3;4;2]
-
-let () =
-  sexp_print <:sexp_of<Iet.t>> iet
-
-let print_cycle (strand,side) =
-  Iet_utils.find_cycle iet (Strand.of_int strand,side) 
-  |> sexp_print <:sexp_of<(Strand.t * Side.t) list>>
-
-let () =
+let run () =
+(*
+  let iet =
+    Iet.create_simple
+      { top = [0;1;2;0]; bot = [3;2;4;3;1;4] }
+      ~widths:[6;2;3;4;2]
+  in
+*)
+  let iet =
+    Iet.create_simple
+      { top = [0;1;2]; bot = [1;0;2] }
+      ~widths:[1;2;1]
+  in
+  sexp_print <:sexp_of<Iet.t>> iet;
+  let print_cycle (strand,side) =
+    Iet_utils.find_cycle iet (Strand.of_int strand,side) 
+    |> sexp_print <:sexp_of<(Strand.t * Side.t) list>>
+  in
   print_cycle (0,Top);
   print_cycle (0,Bot);
   print_cycle (8,Top);
-  print_cycle (8,Bot);
+  print_cycle (8,Bot)
+
+let () =
+  Exn.handle_uncaught ~exit:true run

File ocaml/iet.ml

   }
 with sexp
 
+let is_in_attachment {strand_range=(lo,hi); side = att_side} (strand,side) =
+  Strand.(strand >=lo && strand <= hi)
+  && side = att_side
+
+type annotated_branch =
+  { start: Strand.t
+  ; branch: Branch.t
+  ; width: int
+  ; side: Side.t
+  }
+with sexp
+
 type t = { branch_by_strand : Branch.t Strand.Map.t Side_pair.t
          ; attachments : (attachment * attachment) Branch.Map.t
+         (* ; annotated_branches : annotated_branch list *)
          ; num_strands : int
          }
 with sexp
 
 let num_strands t = t.num_strands
 
-type annotated_branch =
-  { start: Strand.t
-  ; branch: Branch.t
-  ; width: int
-  ; side: Side.t
-  }
+let index_branches_by_strand annotated_branches =
+  List.fold annotated_branches
+    ~init:(Side_pair.of_fn (fun _ -> Strand.Map.empty))
+    ~f:(fun maps {side;start;branch;width} ->
+        Side_pair.change maps side ~f:(fun map ->
+            List.fold (List.range 0 width)
+              ~init:map
+              ~f:(fun map i ->
+                  let strand = Strand.(start +: i) in
+                  Map.add map ~key:strand ~data:branch
+                )))
+
+let annotate_branches branches ~widths side = 
+  List.fold (Side_pair.get branches side) ~init:(Strand.zero,[])
+    ~f:(fun (start,acc) branch ->
+        let width = Map.find_exn widths branch in
+        let start' = Strand.(start +: width) in
+        (start',
+         {side; start; branch; width} :: acc)
+      )
+  |> snd
 
 let create branches ~widths =
-  let annotate_branches side = 
-    List.fold (Side_pair.get branches side) ~init:(Strand.zero,[])
-      ~f:(fun (start,acc) branch ->
-          let width = Map.find_exn widths branch in
-          let start' = Strand.(start +: Int.(width - 1)) in
-          (start',
-           {side; start; branch; width} :: acc)
-        )
-    |> snd
+  let annotated_branches =
+    let of_side side = annotate_branches branches ~widths side in
+    of_side Top @ of_side Bot
   in
-  let annotated_branches =
-    annotate_branches Top @ annotate_branches Bot
-  in
-  let branch_by_strand = 
-    List.fold annotated_branches
-      ~init:(Side_pair.of_fn (fun _ -> Strand.Map.empty))
-      ~f:(fun maps {side;start;branch;width} ->
-          Side_pair.change maps side ~f:(fun map ->
-              List.fold (List.range 0 width)
-                ~init:map
-                ~f:(fun map i ->
-                    let strand = Strand.(start +: i) in
-                    Map.add map ~key:strand ~data:branch
-                  )))
+  let branch_by_strand =
+    index_branches_by_strand annotated_branches
   in
   let attachments =
     annotated_branches
                  <:sexp_of<Branch.t>>
       )
   in
-  let num_strands = Map.length branch_by_strand.top in
-  assert (num_strands = Map.length branch_by_strand.bot);
-  { branch_by_strand; attachments; num_strands }
+  let top_strands = Map.length branch_by_strand.top in
+  let bot_strands = Map.length branch_by_strand.bot in
+  let t = { branch_by_strand
+          ; attachments
+          (* ; annotated_branches*)
+          ; num_strands = top_strands }
+  in
+  if top_strands <> bot_strands then
+    failwiths "Mismatch between number of top_strands and bot_strands"
+      (top_strands,bot_strands,t)
+      <:sexp_of<int * int * t>>
+  ;
+  t
     
 
 let create_simple branches ~widths =
   in
   create branches ~widths
 
+
+include Pretty_printer.Register (struct
+    type z = t
+    type t = z
+    let module_name = "Iet"
+    let to_string t =
+      sexp_of_t t |> Sexp.to_string_hum
+  end)

File ocaml/iet.mli

 open Common
 
 type t with sexp
+include Pretty_printer.S with type t := t
 
 (** {2 Creation functions} *)
 
   { strand_range : Strand.t * Strand.t
   ; side    : Side.t
   }
+with sexp
+
+val is_in_attachment : attachment -> (Strand.t * Side.t) -> bool
 
 val lookup_attachments
   :  t

File ocaml/iet_utils.ml

 open Common
 
 
-let in_range (low,high) x =
-  Strand.(x >= low && x <= high)
-
 (* Given a strand and a side in an IET, find the strand/side pair
    that it is connected to by the branch in question *)
 let find_next iet (strand, side) =
   (* Figure out the branch associated with this strand/side pair,
      and the branch it's connected to *)
   let (mine,other) =
-    if in_range attach2.strand_range strand
+    if Iet.is_in_attachment attach1 (strand,side)
     then (attach1,attach2)
     else (
-      assert (in_range attach2.strand_range strand);
+      if not (Iet.is_in_attachment attach2 (strand,side)) then
+        failwiths "Strand is not in either range"
+          (attach1,attach2,(strand,side))
+        <:sexp_of<Iet.attachment * Iet.attachment * (Strand.t * Side.t)>>
+      ;
+      (* assert (in_range attach2.strand_range strand); *)
       (attach2,attach1)
     )
   in

File ocaml/ocamlinit

+#warnings "-40";;
 #require "core";;
 #directory "_build";;
-#load "permutation.cmo";;
+#load_rec "iet_utils.cmo";;
 #require "core.top"
 open Core.Std;;
-open Permutation;;
-open Permutation.Infix;;
+open Common;;

File ocaml/private_int.ml

   type t with sexp
   include Hashable   with type t := t
   include Comparable with type t := t
+  include Pretty_printer.S with type t := t
   val (+:) : t -> int -> t
   val (-:) : t -> int -> t
   val (-) : t -> t -> int
 #!/usr/bin/env bash
 
-./build_all.sh
+make -s iet_utils.byte
 utop -init ./ocamlinit
 

File ocaml/strand.ml

+open Core.Std
+include Private_int.M
+
+include Pretty_printer.Register (struct
+    type z = t
+    type t = z
+    let module_name = "Strand"
+    let to_string = to_string
+  end)

File ocaml/strand.mli

+include Private_int.S