packages feed

egison-4.1.3: lib/core/assoc.egi

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

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

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

--
-- Assoc Multiset
--
def assocMultiset a :=
  matcher
    | [] as () with
      | [] -> [()]
      | _ -> []
    | #$x ^ #$n :: $ as (assocMultiset a) with
      | $tgt ->
        matchAll tgt as list (a, integer) with
          | $hs ++ (#x, ?(>= n) & $k) :: $ts ->
            if k - n = 0 then hs ++ ts else hs ++ (x, k - n) :: ts
    | $ ^ #$n :: $ as (a, assocMultiset a) with
      | $tgt ->
        matchAll tgt as list (a, 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 a) with
      | $tgt ->
        matchAll tgt as list (a, integer) with
          | $hs ++ (#x, $n) :: $ts -> (n, hs ++ ts)
    | $ ^ $ :: $ as (a, integer, assocMultiset a) with
      | $tgt ->
        matchAll tgt as list (a, integer) with
          | $hs ++ ($x, $n) :: $ts -> (x, n, hs ++ ts)
    | #$x :: $ as (assocMultiset a) with
      | $tgt ->
        matchAll tgt as list (a, integer) with
          | $hs ++ (#x, $n) :: $ts ->
            if n = 1 then hs ++ ts else hs ++ (x, n - 1) :: ts
    | $ :: $ as (a, assocMultiset a) with
      | $tgt ->
        matchAll tgt as list (a, integer) with
          | $hs ++ ($x, $n) :: $ts ->
            if n = 1 then (x, hs ++ ts) else (x, hs ++ (x, n - 1) :: ts)
    | $ as (something) with
      | $tgt -> [tgt]

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

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