diff --git a/dune-project b/dune-project index 94169d7126f099541b3131a460758d47255ad29a..64e3c95786ef6cc714f9291b0068af3b8c9436a5 100644 --- a/dune-project +++ b/dune-project @@ -19,7 +19,7 @@ (name ocaml_edt) (synopsis "Generates timetables for course planification") (description "Program and library to generate a timetable for a course or a set of courses, outputs in HTML format among others") - (depends ocaml dune cmdliner) + (depends ocaml dune cmdliner calendar) (tags (topics "timetable"))) diff --git a/lib/Timetable.ml b/lib/Timetable.ml new file mode 100644 index 0000000000000000000000000000000000000000..6b1e7ddcecdd9839d01c15aa90a5ca2139d4894c --- /dev/null +++ b/lib/Timetable.ml @@ -0,0 +1,99 @@ +let lex access cmp fn v1 v2 = + let v = fn v1 v2 in + if v != 0 then v else cmp (access v1) (access v2) + +let lex_r access cmp fn v1 v2 = + let v = cmp (access v1) (access v2) in + if v != 0 then v else fn v1 v2 + +let eq _ _ = 0 +let rec gcd n m = if m = 0 then n else gcd m (n mod m) + +type date = CalendarLib.Date.t + +let as_iso (d : date) : string = CalendarLib.Printer.Date.sprint "%F" d + +type 'a cell = { rowspan : int; colspan : int; content : 'a } +type 'a line = { headers : string cell list; cells : 'a cell list } + +type 'a table = { + columns_headers : string cell list list; + lines : 'a line list; +} + +module type ResourcesT = sig + type t + + val conflicts : t -> t -> bool + val compare : t -> t -> int +end + +module Make (R : ResourcesT) = struct + module D = CalendarLib.Date + + type heure = int + + let heure (h : int) (m : int) : heure = (h * 60) + m + + type creneau = { resources : R.t; date : date; start : heure; duration : int } + + let compare = + eq + |> lex (fun c -> c.date) D.compare + |> lex (fun c -> c.start) ( - ) + |> lex (fun c -> c.duration) ( - ) + |> lex (fun c -> c.resources) R.compare + + let inside h h' d = h' <= h && h <= h' + d + + let intersect c1 c2 = + c1.date = c2.date + && (inside c1.start c2.start c2.duration + || inside c2.start c1.start c1.duration) + + let conflict c1 c2 = intersect c1 c2 && R.conflicts c1.resources c2.resources + let date = D.make + + let week_of_date d : date = + let day = D.day_of_week d in + let offset = 1 - D.int_of_day day in + D.add d (D.Period.day offset) + + exception Conflit of (creneau * creneau) + + let rec supprime_conflits raise_exc c l = + match l with + | [] -> l + | c' :: rest -> + if conflict c c' then + if raise_exc then raise (Conflit (c, c')) + else supprime_conflits raise_exc c rest + else + let l_s = supprime_conflits raise_exc c rest in + if l_s == rest then l else l_s + + let rec place (raise_exc : bool) (c : creneau) (l : creneau list) : + creneau list = + match l with + | [] -> [ c ] + | c' :: rest when conflict c c' -> place raise_exc c rest + | c' :: rest when compare c' c <= 0 -> c' :: place raise_exc c rest + | c' :: rest -> c :: c' :: supprime_conflits raise_exc c rest + + let groupby gv cmp cmp2 l = + let l = List.map (fun c -> (gv c, c)) l in + let cmp_p = eq |> lex fst cmp |> lex snd cmp2 in + let l = List.sort cmp_p l in + let rec aux = function + | [] -> [] + | (v, c) :: rest -> ( + match aux rest with + | [] -> [ (v, [ c ]) ] + | (v', cs') :: rest' -> + if v = v' then (v', c :: cs') :: rest' + else (v, [ c ]) :: (v', cs') :: rest') + in + aux l + + let by_week l = groupby (fun c -> week_of_date c.date) D.compare compare l +end diff --git a/lib/dune b/lib/dune index cfb89e8d39cca249153ef1c2d3385c61b6f3e95e..f7645f93e775a01680ec831c18a3a43c03b3ff9d 100644 --- a/lib/dune +++ b/lib/dune @@ -1,2 +1,3 @@ (library - (name ocaml_edt)) + (name ocaml_edt) + (libraries calendar)) diff --git a/ocaml_edt.opam b/ocaml_edt.opam index fc7a0ecdf20dfded7722c0ac385746510ee341e0..a832823f9219b12f57c0f557a15f1dd40af9eb67 100644 --- a/ocaml_edt.opam +++ b/ocaml_edt.opam @@ -14,6 +14,7 @@ depends: [ "ocaml" "dune" {>= "3.16"} "cmdliner" + "calendar" "odoc" {with-doc} ] build: [