diff options
Diffstat (limited to 'semestr-3/pf/lista7/Perm.ml')
-rw-r--r-- | semestr-3/pf/lista7/Perm.ml | 114 |
1 files changed, 114 insertions, 0 deletions
diff --git a/semestr-3/pf/lista7/Perm.ml b/semestr-3/pf/lista7/Perm.ml new file mode 100644 index 0000000..1b19bac --- /dev/null +++ b/semestr-3/pf/lista7/Perm.ml @@ -0,0 +1,114 @@ +module type OrderedType = sig + type t + val compare : t -> t -> int +end + +module type S = sig + type key + type t + (** permutacja jako funkcja *) + val apply : t -> key -> key + (** permutacja identycznościowa *) + val id : t + (** permutacja odwrotna *) + val invert : t -> t + (** permutacja która tylko zamienia dwa elementy miejscami *) + val swap : key -> key -> t + (** złożenie permutacji (jako złożenie funkcji) *) + val compose : t -> t -> t + (** porównywanie permutacji *) + val compare : t -> t -> int +end + +module Make(Key : OrderedType) : (S with type key = Key.t) = +struct + type key = Key.t + module MapModule = Map.Make(Key) + type t = key MapModule.t * key MapModule.t + let apply ((map, invmap) : t) k = + try (MapModule.find k map) with + | Not_found -> k + let id : t = (MapModule.empty, MapModule.empty) + let invert ((map, invmap) : t) : t = + (invmap, map) + let swap k1 k2 : t = + let (map, invmap) = id in + (MapModule.add k2 k1 (MapModule.add k1 k2 map), MapModule.add k2 k1 (MapModule.add k1 k2 invmap)) + let compose ((map1, invmap1) : t) ((map2, invmap2) : t) : t = + let f map x m1_of_x m2_of_x = match m1_of_x with + | None -> m2_of_x + | Some y -> match MapModule.find_opt y map with + | None -> Some y + | Some z -> Some z + in (MapModule.merge (f map2) map1 map2, + MapModule.merge (f invmap1) invmap2 invmap1) + let compare ((map1, invmap1) : t) ((map2, invmap2): t) = + MapModule.compare Key.compare map1 map2 +end + +module StringOrder: (OrderedType with type t = string) = +struct + type t = string + let compare s1 s2 = if s1 < s2 then -1 else if s1 > s2 then 1 else 0 +end + +module StringPerm = Make(StringOrder) +let p = StringPerm.compose (StringPerm.swap "1" "2") (StringPerm.swap "2" "3");; + +(* Zadanie 2 *) + +let is_generated (type a) (packed : (module S with type t = a)) (perm : a) (generators : (a list)) = + let module PermModule = (val packed : (S with type t = a)) in + let module OrderedPerm : (OrderedType with type t = a) = + struct + type t = a + let compare p1 p2 = PermModule.compare p1 p2 + end in + let module SS = Set.Make(OrderedPerm) in + let rec flatmap f = function + | [] -> [] + | x :: xs -> (f x) @ flatmap f xs in + let saturate xn = + let perms = SS.elements xn in + let inverts = List.map (fun p -> PermModule.invert p) perms in + let compositions = flatmap (fun p -> (List.map (fun q -> PermModule.compose p q) perms)) perms in + SS.union xn (SS.union (SS.of_list inverts) (SS.of_list compositions)) in + let rec iter xn = + let xn1 = saturate xn in + if SS.mem perm xn1 then true else + if SS.compare xn xn1 == 0 then false else + iter xn1 + in iter (SS.of_list generators) + +(* Zadanie 3 *) + +module OrderedList (X : OrderedType) : (OrderedType with type t = X.t list) = +struct + type t = X.t list + let rec compare (xs: t) (ys: t) = + match (xs, ys) with + | ([], []) -> 0 + | ([], _) -> -1 + | (_, []) -> 1 + | (x :: xs, y :: ys) -> let cmp = X.compare x y in + if cmp == 0 then compare xs ys else cmp +end + +module OrderedPair (X : OrderedType) : (OrderedType with type t = X.t * X.t) = +struct + type t = X.t * X.t + let compare ((a, b): t) ((c, d) : t) = + let cmp = X.compare a c in + if cmp == 0 then X.compare b d else cmp +end + +module OrderedOption (X : OrderedType) : (OrderedType with type t = X.t option) = +struct + type t = X.t option + let compare (a: t) (b: t) = + match (a, b) with + | (None, None) -> 0 + | (None, _) -> -1 + | (_, None) -> 1 + | (Some a, Some b) -> X.compare a b +end |