packages feed

egison-4.0.0: lib/core/assoc.egi

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

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

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

--
-- Assoc List
--
assocList a :=
  matcher
    | [] as () with
      | [] -> [()]
      | _ -> []
    | $ :: $ as (a, assocList a) with
      | $tgt ->
        match tgt as list (something, integer) with
          | ($x, #1) :: $rs -> [(x, rs)]
          | ($x, $n) :: $rs -> [(x, (x, n - 1) :: rs)]
          | _ -> []
    | ncons $ #$k $ as (a, assocList a) with
      | $tgt ->
        match tgt as list (something, integer) with
          | ($x, #k) :: $rs -> [(x, rs)]
          | ($x, ?(> k) & $n) :: $rs -> [(x, (x, n - k) :: rs)]
          | _ -> []
    | ncons $ $ $ as (a, integer, assocList a) with
      | $tgt ->
        match tgt as list (something, integer) with
          | ($x, $k) :: $rs -> [(x, k, rs)]
          | _ -> []
    | #$val as () with
      | $tgt -> if val = tgt then [()] else []
    | $ as (something) with
      | $tgt -> [tgt]

--
-- Assoc Multiset
--
assocMultiset a :=
  matcher
    | [] as () with
      | [] -> [()]
      | _ -> []
    | #$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)
    | ncons #$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
    | ncons $ #$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)
    | ncons #$x $ $ as (integer, assocMultiset a) with
      | $tgt ->
        matchAll tgt as list (a, integer) with
          | $hs ++ (#x, $n) :: $ts -> (n, hs ++ ts)
    | ncons $ $ $ as (a, integer, assocMultiset a) with
      | $tgt ->
        matchAll tgt as list (a, integer) with
          | $hs ++ ($x, $n) :: $ts -> (x, n, hs ++ ts)
    | $ as (something) with
      | $tgt -> [tgt]

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

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