assoc.egi

--
--
-- Assoc-Collection
--
--

def toAssoc (xs: [a]) : [(a, Integer)] :=
  match xs as list something with
    | [] -> []
    | $x :: (loop $i (2, $n)
               (#x :: ...)
               (!(#x :: _) & $rs)) -> (x, n) :: toAssoc rs

def fromAssoc {a} (xs: [(a, Integer)]) : [a] :=
  match xs as list (something, integer) with
    | [] -> []
    | ($x, $n) :: $rs -> take n (repeat1 x) ++ fromAssoc rs

--
-- Assoc Multiset
--

def assocMultiset {a} (m: Matcher a) : Matcher [(a, Integer)] :=
  matcher
    | [] as () with
      | [] -> [()]
      | _ -> []
    | (#$x, #$n) :: $ as (assocMultiset m) with
      | $tgt ->
        matchAll tgt as list (m, integer) with
          | $hs ++ (#x, ?(>= n) & $k) :: $ts ->
            if k - n = 0 then hs ++ ts else hs ++ ((x, k - n) :: ts)
    | ($, #$n) :: $ as (m, assocMultiset m) with
      | $tgt ->
        matchAll tgt as list (m, integer) with
          | $hs ++ ($x, ?(>= n) & $k) :: $ts ->
            if k - n = 0 then (x, hs ++ ts) else (x, hs ++ ((x, k - n) :: ts))
    | (#$x, $) :: $ as (integer, assocMultiset m) with
      | $tgt ->
        matchAll tgt as list (m, integer) with
          | $hs ++ (#x, $n) :: $ts -> (n, hs ++ ts)
    | ($, $) :: $ as (m, integer, assocMultiset m) with
      | $tgt ->
        matchAll tgt as list (m, integer) with
          | $hs ++ ($x, $n) :: $ts -> (x, n, hs ++ ts)
    | #$x :: $ as (assocMultiset m) with
      | $tgt ->
        matchAll tgt as list (m, integer) with
          | $hs ++ (#x, $n) :: $ts ->
            if n = 1 then hs ++ ts else hs ++ (x, n - 1) :: ts
    | $ as (something) with
      | $tgt -> [tgt]

def AC.intersect (xs : [(a, Integer)]) (ys : [(a, Integer)]) : [(a, Integer)] :=
  matchAll (xs, ys) as (assocMultiset something, assocMultiset something) with
    | (($x, $m) :: _, (#x, $n) :: _) -> (x, min m n)

def AC.intersectAs (m : Matcher a) (xs : [(a, Integer)]) (ys : [(a, Integer)]) : [(a, Integer)] :=
  matchAll (xs, ys) as (assocMultiset m, assocMultiset m) with
    | (($x, $m) :: _, (#x, $n) :: _) -> (x, min m n)