Unison Challenge (2024-Jun-14)

challenge.u

-- make a window structure from a list of items.
-- the structure arranges items in groups of 2, with only
-- the last element left alone (so it can be paired with the next).
makeWindow : (a -> a ->{g} a) -> Optional a -> [a] ->{g} [a]
makeWindow op prev = cases
    [item] -> match prev with
        Some p -> [op p item, item]
        None -> [item]
    item +: tail ->
        match prev with
            Some p -> 
                 next = op p item
                 next +: makeWindow op (Some item) tail
            None -> makeWindow op (Some item) tail

-- update the window structure and emit the next window.
-- an update consists of taking the first group, joining it
-- with the third group, then the fifth and so on until
-- reaching the last element. the new window strcuture
-- drops the first item and pushes a new group at the end.
update : (a -> a ->{g} a) -> a -> a -> [a] ->{g} ([a], a)
update op zero item window =
    use List
    skipping1 = cases
        [] -> []
        [a] -> [a]
        [a, b] ++ tail -> a +: skipping1 tail
    w = (dropLast window) ++ match window with
        [] -> []
        _ :+ last -> [op last item, item]
    join = skipping1 >> foldLeft op zero
    (List.drop 1 w, join w)

unique ability Window v where
    put : v -> Optional v

withWindow : (a -> a ->{g} a) -> a -> Nat -> '{g, Window a} r -> r
withWindow op zero size actions =

    -- impl emits an element for each put call.
    -- It assumes the window structure has been already setup
    -- and keeps it in the expected format.
    impl : [a] -> Request (Window a) r -> r
    impl window = cases
        { pure } -> pure
        { Window.put item -> resume } ->
            (w, v) = update op zero item window
            handle resume (Some v) with impl w 

    -- preImpl puts elements into a list until it reaches
    -- the size of a window, then switches to 'impl'
    preImpl : [a] -> Nat -> Request (Window a) r -> r
    preImpl items remaining = cases
        { pure } -> pure
        { Window.put item -> resume } ->
            if remaining > 1 then
              w = items :+ item
              r = decrement remaining
              handle resume None with preImpl w r
            else
              window = makeWindow op None items
              (w, v) = update op zero item window
              handle resume (Some v) with impl w
    handle actions () with preImpl [] size

_sliding : a -> (a -> a ->{g} a) -> Nat -> [a] ->{g, Window a} [a]
_sliding  zero        op             k = cases
    [] -> []
    item +: tail ->
        next = match Window.put item with
            Some x -> [x]
            None -> []
        next ++ _sliding zero op k tail 

sliding : a -> (a -> a ->{g} a) -> Nat -> [a] ->{g} [a]
sliding  zero        op             k     input =
    withWindow op zero k do _sliding zero op k input

-- Counter ability to help debug the impl complexity
structural ability Counter where
    count : ()
    total : 'Nat

withCounter : '{g, Counter} r -> (r, Nat)
withCounter actions =
    impl value = cases
        { p } -> (p, value)
        { Counter.count -> resume } ->
            handle !resume with impl (value + 1)
        { Counter.total _ -> resume } ->
            handle resume value with impl value
    handle !actions with impl 0

debugP : Text -> Text ->{Counter} Text
debugP a b =
    count
    (Text.++) a b

> withCounter '(sliding "" (debugP) 6 ["a","b","c"])
> withCounter '(sliding "" (debugP) 6 ["a","b","c","d"])
> withCounter '(sliding "" (debugP) 6 ["a","b","c","d","e"])
> withCounter '(sliding "" (debugP) 6 ["a","b","c","d","e","f"])
> withCounter '(sliding "" (debugP) 6 ["a","b","c","d","e","f","g"])
> withCounter '(sliding "" (debugP) 6 ["a","b","c","d","e","f","g","h"])


-----

---- Trivial Solution:

_sliding : a -> (a -> a -> a) -> Nat -> [a] -> [a] -> [a]
_sliding  zero        op          k     acc = cases
   [] -> []
   head +: tail ->
       acc2 = acc :+ head
       (h2, acc3) = if List.size acc2 == k
            then ([List.foldLeft op zero acc2], drop 1 acc2)
            else ([], acc2)
       h2 ++ _sliding zero op k acc3 tail

sliding : a -> (a -> a -> a) -> Nat -> [a] -> [a]
sliding  zero        op          k     input =
    _sliding zero op k [] input

> sliding "" (Text.++) 3 ["a","b","c", "d","e"]

---