Accelerated Intro to CS

This is just one solution, not the 'best' solution, you can design your programs however you want.

include lists

fun dot-product(vec-a :: List<Number>, vec-b :: List<Number>)-> Number:
  doc: "Returns the dot-product of vec-a and vec-b"
  if vec-a.length() == vec-b.length():
    fold2(lam(acc, elt1, elt2): acc + (elt1 * elt2) end, 0, vec-a, vec-b)
  else:
    raise("Vectors are not the same dimensions")
  end
where:
  dot-product([list: 0, 2, 3], [list: 3, 0, 0]) is 0
  dot-product(empty, [list: 1]) raises "Vectors are not the same dimensions"
end

fun make-vec(both-docs :: List<String>, d :: List<String>)-> List<Number>:
  doc: "Creates a vector of d using both-docs"
  cases (List) both-docs: 
    | empty => empty
    | link(f, r) => 
      if d.member(f):
        link(d.filter(lam(x): string-equal(f, x) end).length(),
          make-vec(r, d.filter(lam(x): not(x == f) end)))
      else:
        link(0, make-vec(r, d))
      end
  end
where:
  make-vec([list: "a", "b", "c"], [list: "d"]) is [list: 0, 0, 0]
  # Property-based test where 2 similar words should be [list: 0, 2, 0]
  make-vec([list: "a", "b", "c"], [list: "b", "b"])
    .foldl(lam(elt, acc): acc + elt end, 0) is 2
  # Property-based test where all similar words should be length of vec
  make-vec([list: "a", "b", "c"], [list: "a", "a", "a"]).length() is 3

end

fun overlap(doc1 :: List<String>, doc2 :: List<String>)-> Number:
  doc: "Computes the overlap between doc1 and doc2"

  if (doc1 == empty) or (doc2 == empty):
    raise("Empty input")
  else:
    combined = distinct(doc1.append(doc2).map(string-to-lower).sort())
    vec1 = make-vec(combined, doc1.map(string-to-lower))
    vec2 = make-vec(combined, doc2.map(string-to-lower))
    # normalized 
    (dot-product(vec1, vec2)) / num-max(
      num-sqr(num-sqrt(dot-product(vec1, vec1))), 
      num-sqr(num-sqrt(dot-product(vec2, vec2))))
  end
where:
  overlap(empty, empty) raises "Empty input"
  # these examples taken from the Examplar paper
  overlap([list: "welcome", "to", "Walmart"], 
    [list: "WELCOME", "To", "walmart"]) is-roughly 3/3
  overlap([list: "1", "!", "A", "?", "b"], 
    [list: "1", "A", "b"]) is-roughly 3/5
  overlap([list: "alakazam", "abra"],
    [list: "abra", "kadabra", "alakazam", "abra"]) is-roughly 2/4
  overlap([list: "a", "b"], [list: "c"]) is 0/3

  # epsilon test for roughnums
  epsilon = 0.00001
  a = [list: "alakazam", "abra"]
  b = [list: "abra", "kadabra", "alakazam", "abra"]

  num-abs(overlap(a, b) - 2/4) <= epsilon is true  
end

I wrote this on a phone during a lunch break. I used + to concat two lists together, which I can't find anywhere in the documentation but I rewrote it myself anyway. I didn't rewrite length/distinct/member since I've already done so many times, if you haven't try it, this assignment is all about practice. All you need to do is get something working, then you learned enough about the problem you can trash all the code and rewrite it.

data Recommendation:
  | recommendation(count :: Number, names :: List<String>)
end

data File:
  | file(name :: String, content :: String)
end

fun cat<T>(l1 :: List<T>, l2 :: List<T>)-> List<T>:
  doc: "Rewrite of the list concat operator"
  if l1 == empty:
    l2
  else if l2 == empty:
    l1
  else:
    foldr(lam(acc, elt): 
        # if we find an embedded list, fold it using the acc from l1
        if is-link(elt):
          foldr(lam(ac, x): link(x, ac) end, acc, elt)
        else:
          link(elt, acc)
        end
      end, empty, link(l1, l2))
  end
where:
  cat([list: 1, 2], [list: 3, 4]) is [list: 1, 2, 3, 4]
  cat([list: 1], [list: ]) is [list: 1]
  cat([list: ], [list: 1]) is [list: 1]
end

fun data-clean(s :: String)-> List<String>:
  doc: "Removes newline codepoint from l"

  fun helper(lon :: List<Number>, acc :: String)-> List<String>:
    cases (List) lon:
      |empty => link(acc, empty)
      |link(f, r) =>
        # string-to-code-point("\n") == 10
        if f == 10:
          link(acc, helper(r, ""))
        else:
          helper(r, acc + string-from-code-point(f))
        end
    end
  end

  if (s == ""):
    empty
  else:
    helper(string-to-code-points(s), "")
  end   
where:
  data-clean("C\na") is [list: "C", "a"]
  data-clean("") is empty
end

fun find-recs(f :: File, t :: String)-> List<String>:
  doc: "List of titles from f containing t" 
  book-list = data-clean(f.content)
  # if t is in data-clean(file) return list without t
  if book-list.filter(lam(elt): elt == t end).length() > 0:
    book-list.filter(lam(elt): not(elt == t) end)
  else:
    empty
  end
end

fun combine-recs(lof :: List<File>, t :: String)-> List<String>:
  doc: "Combines all books (including dupes) from all files containing t"
  cases (List) lof:
    | empty => empty
    | link(f, r) => find-recs(f, t) + combine-recs(r, t)
  end
end

fun make-recs(los1 :: List<String>, los2 :: List<String>)->List<Recommendation>:
  doc:"List of recommendations from los1"
  cases (List) los1:
    | empty => empty
    | link(f, r) =>
      # filter r to prevent dupes after building recommendation for f
      link(recommendation(los2.filter(lam(x): f == x end).length(), link(f, empty)), 
        make-recs(r.filter(lam(elt): not(f == elt) end), los2))
  end
end

fun find-max(lor :: List<Recommendation>, acc :: Recommendation)-> Recommendation:
  doc:"The largest recommendation in lor"
  cases (List) lor:
    | empty => acc
    | link(f, r) =>
      if f.count >= acc.count:
        # if f is biggest it's the new acc
        find-max(r, f)
      else:
        find-max(r, acc)
      end
  end
end

fun recommend(title :: String, book-records :: List<File>)-> Recommendation:
  doc: "Recommends most often bought books with title"

  all-books = combine-recs(book-records, title)
  recs = make-recs(all-books, all-books)
  max = find-max(recs, recommendation(0, [list: ]))
  if max.count > 0:
    # filter the list of recs by count, link names, sort result
    recommendation(max.count, recs.filter(lam(x): x.count == max.count end)
        .foldl(lam(elt, acc): elt.names + acc end, empty).sort())
  else:
    max
  end
where:
  file-1 = file("", "Crime and Punishment\nHeaps are Lame\nLord of the Flies")
  file-2 = file("", "Crime and Punishment\nRandom Book\nLord of the Flies")
  file-3 = file("", "Test Book\nHeaps are Lame\nRandom Book")
  input = [list: file-1, file-2, file-3]

  recommend("No Recommendation", input) is recommendation(0, empty)
  recommend("Crime and Punishment", input) is recommendation(2, [list: "Lord of the Flies"])
  recommend("Test Book", input) is recommendation(1, [list: "Heaps are Lame", "Random Book"])
  recommend("No Recommendation", input) is recommendation(0, empty)

  file-4 = file("", "a\nb\nc\nd")
  file-5 = file("", "d\na")
  input2 = [list: file-4, file-5]
  recommend("d", input2) is recommendation(2, [list: "a"])
end

data BookPair:
  | pair(book1 :: String, book2 :: String)
end

fun popular-pairs(records :: List<File>)-> Recommendation<BookPair>:
  doc: "Find the most often paired titles in record"

  # fold records and get a distinct list of all titles
  cleaned = distinct(records.foldl(lam(x, acc): acc + data-clean(x.content) end, empty))
  # map over titles and get recommendations for each 
  all-pairs = cleaned.map(lam(x): recommendation(recommend(x, records).count, 
      recommend(x, records).names.map(lam(elt): pair(elt, x) end)) end)
  # find the max recommendation and filter all-pairs 
  max-pair = find-max(all-pairs, recommendation(0, empty))
  result = all-pairs.filter(lam(x): x.count == max-pair.count end)
  # create recommendation with list of duplicate pairs 
  dupe-pairs = result.foldl(lam(elt, acc): recommendation(max-pair.count, acc.names + elt.names) end, recommendation(0, empty))
  # return recommendation(count, distinct list of pairs)
  recommendation(max-pair.count, 
    dupe-pairs.names.foldl(lam(x, acc): 
      if acc.member(pair(x.book2, x.book1)): acc + empty else: acc + [list: x] end end, empty))
where:

  a = file("", "C\nH\nL")
  b = file("", "C\nR\nL")
  c = file("", "T\nH\nR")

  popular-pairs([list: a]) is recommendation(1, [list: pair("H", "C"), pair("L", "C"), pair("L", "H")])
  popular-pairs([list: a, b, c]) is recommendation(2, [list: pair("L", "C")])
  popular-pairs(empty) is recommendation(0, empty)
end

# CSCI0190 (Fall 2018)
provide *
provide-types *

import shared-gdrive("oracle-support.arr",
  "11JjbUnU58ZJCXSphUEyIODD1YaDLAPLm") as O

##### PUT IMPORTS BELOW HERE ############


##### PUT IMPORTS ABOVE HERE ############

type Hire = O.Hire
hire = O.hire
is-hire = O.is-hire
matchmaker = O.matchmaker

# DO NOT CHANGE ANYTHING ABOVE THIS LINE

fun generate-input(num :: Number) -> List<List<Number>>:
  doc: 
  ```
  generates a list of candidates or companies for a group of size num
  ```
  empty
where:
  generate-input(0) is empty
end

fun is-valid(
    companies :: List<List<Number>>,
    candidates :: List<List<Number>>,
    hires :: Set<Hire>)
  -> Boolean:
  doc: 
  ```
  Tells if the set of hires is a good match for the given
  company and candidate preferences.
  ```
  true
where:
  is-valid(empty, empty, empty-set) is true
end

fun oracle(a-matchmaker :: (List<List<Number>>, List<List<Number>> 
      -> Set<Hire>))
  -> Boolean:
  doc: 
  ```
  Takes a purported matchmaking algorithm as input and outputs whether or
  not it always returns the correct response
  ```
  true
where:
  oracle(matchmaker) is true
end

provide *
provide-types *

data File:
  | file(name :: String, size :: Number, content :: String)
end

data Dir:
  | dir(name :: String, ds :: List<Dir>, fs :: List<File>) with:
    method size(self :: Dir) -> Number:
      doc: "Returns combined file size, file count, and sub directory count of a Dir"
      size(self)
    end
end

fun size(d :: Dir) -> Number:
  doc: "Method .size()"

  fun fsize(fd :: Dir) -> Number:
    doc: "Returns file size, and number of files in a Dir"
    fd.fs.foldl(lam(f :: File, acc :: Number): 1 + f.size + acc end, 0)
  end

  fsize(d)
    + map(lam(x :: Dir): 1 + size(x) end, d.ds).foldl(lam(elt, acc): elt + acc end, 0)
end
check:
  a = dir("TS", [list:
      dir("Text", empty, [list: file("part1", 1, "content")])], empty)

  b = dir("Libs", [list: 
      dir("Code", empty, [list: file("hang", 1, "content"), file("draw", 1, "content")]), 
      dir("Docs", empty, [list: file("read!", 1, "content")])], empty)

  c = dir("TS", [list:
      dir("Text", empty, [list: file("part1", 1, "content"), file("part2", 1, "content"), file("part3", 1, "content")]),   
      dir("Libs", [list: 
          dir("Code", empty, [list: file("hang", 1, "content"), file("draw", 2, "content")]), 
          dir("Docs", empty, [list: file("read!", 1, "content")])], empty)],
    [list: file("read!", 1, "content")])

  d = dir("TS", [list:
      dir("Text", empty, [list: file("part1", 99, "content"), file("part2", 52, "content"), file("part3", 17, "content")]),   
      dir("Libs", [list: 
          dir("Code", empty, [list: file("hang", 8, "content"), file("draw", 2, "content")]), 
          dir("Docs", empty, [list: file("read!", 19, "content")])], empty)],
    [list: file("read!", 10, "content")])

  e = dir("TS", empty, [list: file("", 1, "")])

  a.size() is 3
  b.size() is 8
  c.size() is 19
  d.size() is 218
  e.size() is 2
end

I looked at the Pyret source on github to see how to chain multiple methods:

data Dir:
  | dir(name :: String, ds :: List<Dir>, fs :: List<File>) with:
    method size(self :: Dir) -> Number:
      doc: "Returns the size of all sub directories"
      size(self)
    end,
    method path(self :: Dir, s :: String) -> List<Path>:
      doc: "Takes a Dir, and a search string, returns the path"
      path(self, s)
    end
end

fun c-frac(n :: Number) -> Stream<Option<Number>>:
  doc: "Consumes decimal, returns some(fraction integral) stream"
  integral = num-truncate(n)
  decimal = n - integral
  ask:
    | decimal > 0 then:
      new-decimal = 1 / decimal
      lz-link(some(integral), {(): c-frac(new-decimal)})
    | otherwise:
      lz-link(some(integral), {(): mt-stream})
  end
where:
  cf-e :: Stream<Number> = c-frac(generate-e(30))
  cf-phi :: Stream<Number> = c-frac((1 + num-sqrt(5)) / 2)

  take(cf-e, 6) is [list: some(2), some(1), some(2), some(1), some(1), some(4)]
  take(cf-phi, 3) is take(repeating-stream([list: some(1)]), 3)
  take(c-frac(2.875), 4) is [list: some(2), some(1), some(7), none]
  take(c-frac(PI), 5) is [list: some(3), some(7), some(15), some(1), some(292)]
end

# see wikipedia it is the sum of 1/k! where k starts at 0 and keeps going
# 1/0! + 1/1 + 1/(1*2) + 1/(1*2*3) ... where 1/0! is 1.
fun generate-e(n :: Number) -> Number:
  doc:"Generates e (inefficiently) to n decimal places"

  fun e-helper(current-count):
    factorial = take(nats-from(1), current-count)
      .foldr(lam(acc, x): x * acc end, 1)
    lz-link(1 / factorial, {(): e-helper(current-count + 1)})
  end

  take(e-helper(1), n).foldl(lam(acc,x): acc + x end, 1)
where:
  epsilon = 0.0000001
  num-abs((generate-e(10) - 2.7182818)) < epsilon is true

  wikipedia-value = 2.71828182845904523536028747135266249775724709369995
  silly-epsilon = 0.00000000000000000000000000000000000000001
  num-abs(generate-e(60) - wikipedia-value) < silly-epsilon is true
end

check "property-based-test-e":  
  # Property-based testing
  # Any frac stream of e, if integral > 1 it should be even:
  # ie [2, 1, 2, 1, 1, 4, 1, 1, 6, 1, 1, 8, 1, 1...]

  fun e-test(e-value, size-of-approx):
    take(c-frac(e-value), size-of-approx)
      .map(lam(x): if x.value > 1: num-modulo(x.value, 2) == 0 else: 0 end end)
      .filter(lam(y): not(y == 0) end)
      .foldl(lam(z, acc): z and acc end, true)
  end

  e-test(generate-e(10), 10) is true
  e-test(generate-e(20), 20) is true
  e-test(generate-e(30), 30) is true
  # This is false because we need a bigger e generated
  e-test(generate-e(20), 30) is false
end

# First attempt without Options

fun c-approx(c-list :: List<Number>) -> Number:
  doc: "Consumes list of continued fractions, returns rational approximation"

  cases (List) c-list.rest
      | empty => c-list.first
      | link(f, r) => (1 / c-approx(c-list.rest)) + c-list.first
    end
where: 
  # phi test of approximations
  cf-phi :: Stream<Number> = c-frac((1 + num-sqrt(5)) / 2)

  c-approx(take(cf-phi, 3)) is 3/2
  c-approx(take(cf-phi, 4)) is 5/3
  c-approx(take(cf-phi, 5)) is 8/5
  c-approx(take(cf-phi, 6)) is 13/8

  # PI test of approximations
  c-approx(take(c-frac(PI), 1)) is 3
  c-approx(take(c-frac(PI), 2)) is 22/7
  c-approx(take(c-frac(PI), 3)) is 333/106
  c-approx(take(c-frac(PI), 4)) is 355/113 
end

# you can use a map over a stream here too

fun fraction-stream(n :: Stream<Number>) -> Stream<Number>:
  doc: "Consumes stream of continued fraction integrals, returns stream of rationals"

  fun helper(integrals, take-ctr):
    next-approx = take(integrals, take-ctr)
    lz-link(c-approx(next-approx), {(): helper(n, take-ctr + 1)})
  end
  helper(n, 1)
where:
  take(fraction-stream(repeating-stream([list: 1])), 3) is [list: 1, 2, 3/2]
end

# CSCI0190 (Fall 2018)
provide *

import lists as L
import shared-gdrive("map-reduce-support.arr",
  "1F87DfS_i8fp3XeAyclYgW3sJPIf-WRuH") as support

type Tv-pair = support.Tv-pair
tv = support.tv
wc-map = support.wc-map
wc-reduce = support.wc-reduce

# DO NOT CHANGE ANYTHING ABOVE THIS LINE

## A. Your map-reduce definition

fun map-reduce<A,B,M,N,O>(input :: List<Tv-pair<A,B>>,
    mapper :: (Tv-pair<A,B> -> List<Tv-pair<M,N>>),
    reducer :: (Tv-pair<M,List<N>> -> Tv-pair<M,O>))-> List<Tv-pair<M,O>>:
  doc:""

  fun reduce-prepare<S,V>(distinct :: List<S>, pairs :: List<Tv-pair<S,V>>)-> List<Tv-pair<S,List<V>>>:
    doc: "Map over distinct, filter pairs for matching key, collect all their values"
    distinct.map(lam(key): tv(key, pairs.filter(lam(x): x.tag == key end).map(lam(y): y.value end)) end)
  where:
    reduce-prepare([list: "test", "this"], [list: tv("test", 1), tv("this", 1), tv("test", 1)]) 
      is [list: tv("test", [list: 1, 1]), tv("this", [list: 1])]
  end

  # fold the input feeding it to mapper and appending output into a new list
  key-pairs = input.foldl(lam(elt, acc): acc + mapper(elt) end, empty)
  # get a distinct list of keys
  distinct-keys = L.distinct(key-pairs.map(lam(x): x.tag end))
  # create list of tv(key, List<Value>) to pass to reduce
  reduce-ready = reduce-prepare(distinct-keys, key-pairs)
  # map over tv-pairs and apply reduce returning List<Tv-pair<M,O>>
  reduce-ready.map(lam(x): reducer(x) end)
end

check "map-reduce function test":
  input = [list: tv("filename", "the cars fox"), tv("filename2", "fox cars cars cars")]
  map-reduce(input, wc-map, wc-reduce) is [list: tv("the", 1), tv("fox", 2), tv("cars", 4)] 
end

### B. Your anagram implementation  
  
fun anagram-map(input :: Tv-pair<String, String>) 
  -> List<Tv-pair<String, String>>:
  doc:"Returns Tv-pair list of token sorted key and that token"
  # split on spaces of tv-pair.value 
  tokens = string-split-all(input.value, " ")
  # map over the tokens, create key by sorting token
  map(lam(x): tv(string-from-code-points(string-to-code-points(x).sort()), x) end, tokens)
where:
  # tests taken from a student solution
  anagram-map(tv("words.txt", "star rats tarts")) is 
  [list: tv("arst", "star"), tv("arst", "rats"), tv("arstt", "tarts")]
end

fun anagram-reduce(input :: Tv-pair<String, List<String>>) 
  -> Tv-pair<String, List<String>>:
  doc:"Return key and filter for dupes in key value"
  tv(input.tag, L.distinct(input.value))
end

check "anagram test":
  map-reduce([list: tv("words.txt", "star rats tarts")], anagram-map, anagram-reduce) is 
  [list: tv("arst", [list: "star", "rats"]), tv("arstt", [list: "tarts"])]
  
  # will fail because order isn't exact, need to use lst-same-els built-in 
  map-reduce([list: tv("words.txt", "star rats tarts star")], anagram-map, anagram-reduce) is 
  [list: tv("arst", [list: "star", "rats"]), tv("arstt", [list: "tarts"])]
end

import string-dict as SD
import lists as L
type StringDict = SD.StringDict
string-dict = SD.string-dict


### Campus Tour Helper
fun campus-tour-helper(current :: Name, to-visit :: Set<Name>,
    dijk-res :: Traverse, graph :: Graph) -> Path:
  doc:```consumes the current node, the nodes to visit, the dijkstra results,
      and the graph; returns the path as defined in the problem statement```
  destinations = to-visit.to-list()
  cases (List) destinations:
    | empty => empty
    | link(_, _) =>
      nearest-dest = L.foldl(lam(acc, x): 
          if dijk-res.dist.get-value(x) < dijk-res.dist.get-value(acc):
            x
          else:
            acc
          end
        end, destinations.first, destinations)
      dist-to-nodes = dijkstra-helper(nearest-dest, graph, 
        [string-dict: nearest-dest, 0], 
        [string-dict: nearest-dest, [list: nearest-dest]], 
        insert(pp(nearest-dest, 0, [list: nearest-dest]), mt))

      extracted-path = dijk-res.paths.get-value(nearest-dest).reverse().rest
      extracted-path.append(campus-tour-helper(nearest-dest, 
          to-visit.remove(nearest-dest), dist-to-nodes, graph))
  end
  #|
where:
  campus-tour-helper("3", [set: "1", "4"], dijkstra-helper("3", g, 
      [string-dict: "3", 0], [string-dict: "3", [list: "3"]], 
      insert(pp("3", 0, [list: "3"]), mt)), g) is [list: "1", "2", "4"]

  campus-tour-helper("3", empty-set, dijkstra-helper("3", g, 
      [string-dict: "3", 0], [string-dict: "3", [list: "3"]], 
      insert(pp("3", 0, [list: "3"]), mt)), g) is empty |#
end

### Main functions

fun dijkstra(start :: Name, graph :: Graph) -> Set<Path>:
  doc:```consmues a start note and a graph; returns the shortest
      path to each point in the graph from the start```
  nodes = graph.names()
  if nodes.member(start):
    output = dijkstra-helper(start, graph, 
      [string-dict: start, 0], 
      [string-dict: start, [list: start]], 
      insert(pp(start, 0, [list: start]), mt))

    keys = output.paths.keys().to-list()
    list-to-set(map(output.paths.get-value(_), keys))
  else:
    empty-set
  end
end

fun campus-tour(tours :: Set<Tour>, start-position :: Point, 
    campus-data :: Graph) -> Path:
  doc:```consumes a set of tours, a start position, and campus data; returns
      the calculated campus tour as a path```
  all-stops = L.foldl(lam(acc, x): acc.union(x) end, empty-set, 
    map(_.stops, tours.to-list()))

  if all-stops == empty-set:
    empty
  else:
    graph-nodes = map(campus-data.get(_), campus-data.names().to-list())
    cases (List) graph-nodes:
      | empty => empty
      | link(_, _) =>
        start-node = L.foldl(lam(acc, x): if acc.{1} < x.{1}: acc else: 
          x end end, {graph-nodes.first.name; 
            start-position.distance(graph-nodes.first.position)}, 
          map({(x): {x.name; start-position.distance(x.position)}}, 
            graph-nodes)).{0}

        dist-to-nodes = dijkstra-helper(start-node, campus-data, 
          [string-dict: start-node, 0], 
          [string-dict: start-node, [list: start-node]], 
          insert(pp(start-node, 0, [list: start-node]), mt))
        
        if all-stops.member(start-node):
          updated-set = all-stops.remove(start-node)
          link(start-node, campus-tour-helper(start-node, updated-set, 
            dist-to-nodes, campus-data)).reverse()
        else:
          updated-set = all-stops
          link(start-node, campus-tour-helper(start-node, updated-set, 
            dist-to-nodes, campus-data)).reverse()
        end
    end
  end
end

# testing graphs

q1 = place("1", point(0,0), [set: "2", "3"])
q2 = place("2", point(1,0), [set: "1", "3", "4"])
q3 = place("3", point(0,1), [set: "1", "2", "4"])
q4 = place("4", point(2,0), [set: "2", "3"])
g = to-graph([set: q1, q2, q3, q4])

r1 = place("1", point(0,0), [set: "2", "3", "5"])
r2 = place("2", point(1,1), [set: "1", "3", "4"])
r3 = place("3", point(1, -1), [set: "1", "2", "4"])
r4 = place("4", point(2, 0), [set: "2", "3", "5"])
r5 = place("5", point(3, 0), [set: "4", "1"])
g1 = to-graph([set: r1, r2, r3, r4, r5])

### dijkstra helper functions and testing functions

# return type for dijkstra-helper so that it may return both distances and paths
data Traverse:
  | trav(dist :: StringDict<Number>, paths :: StringDict<List<Name>>)
end

fun dijkstra-helper(current :: Name, graph :: Graph, 
    distances :: StringDict<Number>,
    paths :: StringDict<List<Name>>,
    queue :: Heap) -> Traverse:
  doc:```takes in the current node, graph, the distances of nodes added to
      solution, paths, and the queue of paths to check; returns the result of
      dijkstra with both distances and paths```
  cases (Heap) queue:
    | mt => trav(distances, paths)
    | node(_, _, _) =>
      curr-place = graph.get(current)
      neighbors = curr-place.neighbors.to-list()

      # add all neighbors not already in the solution to the queue
      updated-queue = L.foldl(lam(acc :: Heap, x :: Name):
          cases (Option) distances.get(x):
            | none => insert(pp(x, distances.get-value(current) + 
                  curr-place.distance(graph.get(x)), 
                  link(x, paths.get-value(current))), acc)
            | some(_) => acc
          end
        end, queue, neighbors)

      minimum = get-min(updated-queue)
      # if not in the solution add it
      cases (Option) distances.get(minimum.loc):
        | none => 
          dijkstra-helper(minimum.loc, graph, distances.set(minimum.loc, 
              minimum.distance), paths.set(minimum.loc, minimum.path), 
            remove-min(updated-queue))
        | some(_) =>
          dijkstra-helper(minimum.loc, graph, distances, paths, 
            remove-min(updated-queue))
      end
  end
where:
  dijkstra-helper("1", g, [string-dict: "1", 0], [string-dict: "1", 
      [list: "1"]], insert(pp("1", 0, [list: "1"]), mt)) is
  trav([string-dict: "1", 0, "3", 1, "2", 1, "4", 2], [string-dict: "1", 
      [list: "1"], "3", [list: "3", "1"], "2", [list: "2", "1"], "4", 
      [list: "4", "2", "1"]])

  dijkstra-helper("5", g, [string-dict: ], [string-dict: ], mt) 
    is trav([string-dict: ], [string-dict: ])
end

fun is-valid-dijk(proposed :: Set<Path>, start :: Name, graph :: Graph) 
  -> Boolean:
  doc:```consumes a proposed dijkstra solution, a start node, and a graph;
      returns whether each path is a valid solution```
  proposed-list = proposed.to-list()
  if (proposed-list.length() == 0) and 
    not(graph.names().to-list().member(start)):
    true
  else:
    if proposed-list.length() == graph.names().to-list().length():
      if not(proposed-list.length() == 0):
        #checks if all are valid paths
        all-valid = L.all(lam(x): valid-path(x, start, graph) end, 
          proposed-list)

        if all-valid:
          our-lengths = L.foldl(lam(acc, x):
              paths = all-paths(start, x, empty, graph)
              lengths = map(length-path(_, graph), paths)
              min = L.foldl(num-min, lengths.first, lengths)
              acc.set(x, min)
            end, [string-dict: ], graph.names().to-list())

          #checks all lengths
          L.all(lam(x): our-lengths.get-value(x.first) == length-path(x, 
              graph) end, proposed-list)
        else:
          false
        end
      else:
        true
      end
    else:
      false
    end
  end
where:
  is-valid-dijk([set: [list: "4", "2", "1"], [list: "3", "1"], [list: "2", "1"],
      [list: "1"]], "1", g) is true
  is-valid-dijk([set: [list: "4", "2", "1"], [list: "3", "1"], 
      [list: "2", "1"]], "1", g) is false
  is-valid-dijk([set: [list: "4", "2"], [list: "3", "1"], [list: "2", "1"],
      [list: "1"]], "1", g) is false
  is-valid-dijk([set: [list: "4", "2", "3", "1"], [list: "3", "1"], 
      [list: "2", "1"], [list: "1"]], "1", g) is false
end

fun valid-path(path :: Path, start :: Name, graph :: Graph) -> Boolean:
  doc:```given a path, a start, and a graph determines if it is a valid path```
  if path.length() == 0:
    false
  else:
    if path.length() == 1:
      path.first == start
    else:
      is-next-adj = graph.get(path.first).neighbors.member(path.get(1))
      is-next-adj and valid-path(path.rest, start, graph)
    end
  end
where:
  valid-path(empty, "1", g) is false
  valid-path([list: "1"], "1", g) is true
  valid-path([list: "2"], "1", g) is false
  valid-path([list: "4", "2", "3", "1"], "1", g) is true
  valid-path([list: "4", "1"], "1", g) is false
end

fun length-path(path :: Path, graph :: Graph) -> Number:
  doc:```consumes a path and a graph; determines the length of the path```
  cases (List) path.rest:
    | empty => 0
    | link(f, r) =>
      graph.get(path.first).distance(graph.get(f)) 
        + length-path(path.rest, graph)
  end
where:
  length-path([list: "1"], g) is 0
  length-path([list: "4", "2", "1"], g) is 2
end

fun all-paths(start :: Name, target :: Name, seen :: Path, graph :: Graph) 
  -> List<Path>:
  doc:```consumes a start node, target, node, the seen, and the graph;
      returns a list of all Paths to the target from the current```
  if not(start == target):
    current-place = graph.get(start)
    neighbor-paths = map(lam(x): if seen.member(x): empty else: 
          map(link(start, _), all-paths(x, target, link(start, seen), graph)) 
      end end, current-place.neighbors.to-list())
    L.foldl(lam(acc, x): acc.append(x) end, empty, neighbor-paths)        
  else:
    [list: [list: target]]
  end
where:
  all-paths("1", "1", empty, g) is [list: [list: "1"]]
  all-paths("1", "4", empty, g) is [list: [list: "1", "2", "3", "4"], 
    [list: "1", "2", "4"], [list: "1", "3", "2", "4"], [list: "1", "3", "4"]]
end

### campus-tour helper and testing functions
fun is-valid-tour(proposed :: Path, tours :: Set<Tour>, 
    start-position :: Point, graph :: Graph) -> Boolean:
  doc:```consumes a proposed tour, and the input for campus-tour; returns 
      whether the result is a valid tour```
  all-stops = L.foldl(lam(acc, x): acc.union(x) end, empty-set, 
    map(_.stops, tours.to-list()))
  stops-left = L.distinct(L.filter({(x): all-stops.to-list().member(x)}, 
      proposed).reverse())

  if not(all-stops == empty-set) and not(proposed == empty):
    if valid-path(proposed, proposed.last(), graph):
      if all-stops.to-list().length() == stops-left.length():
        graph-nodes = map(graph.get(_), graph.names().to-list())
        distances = map({(x): {x.name; start-position.distance(x.position)}}, 
          graph-nodes)
        minimum-dist = L.foldl(lam(acc, x): if acc.{1} < x.{1}: acc else: 
          x end end, {graph-nodes.first.name; 
            start-position.distance(graph-nodes.first.position)}, distances).{1}

        all-minimal = map({(x): x.{0}}, L.filter({(y): y.{1} == minimum-dist}, 
            distances))
        start-valid = all-minimal.member(proposed.last())
        if start-valid:
          is-valid-tour-on-path(proposed.last(), L.filter(_ == proposed.last(), 
              stops-left), proposed.reverse(), graph)
        else:
          false
        end
      else:
        false
      end
    else:
      false
    end
  else:
    false
  end
where:
  tours = [set: tour("one", [set: "1"]), tour("two", [set: "4"])]
  is-valid-tour([list: "1", "2", "4", "2"], tours, point(0.6, 0.6), g)
    is true
  is-valid-tour([list: "4", "2", "1", "3"], tours, point(0.6, 0.6), g)
    is true
  is-valid-tour([list: "1", "2", "1", "3"], tours, point(0.6, 0.6), g)
    is false
end

fun is-valid-tour-on-path(current :: Name, stops-left :: Path,
    proposed :: Path, graph :: Graph) -> Boolean:
  doc:```consumes the current node, the stops left, the proposed path left
      and the graph; returns if this in line with the greedy algo```
  if stops-left.length() == 0:
    true
  else:
    dijk-res = dijkstra-helper(current, graph, [string-dict: current, 0], 
      [string-dict: current, [list: current]], insert(pp(current, 0, 
          [list: current]), mt))
    minimum-dist = L.foldl(lam(acc, x): 
        if dijk-res.dist.get-value(x) < acc:
          dijk-res.dist.get-value(x)
        else:
          acc
        end
      end, dijk-res.dist.get-value(stops-left.first), stops-left)
    all-minimal = L.filter({(x): dijk-res.dist.get-value(x) == minimum-dist},
      stops-left)

    if all-minimal.member(stops-left.first):
      proposed-to-next = list-up-to-elt(proposed, stops-left.first)
      if length-path(proposed-to-next, graph) == minimum-dist:
        is-valid-tour-on-path(stops-left.first, stops-left.rest, 
          proposed.drop(proposed-to-next.length() - 1), graph)
      else:
        false
      end
    else:
      false
    end
  end
where:
  is-valid-tour-on-path("3", [list: "1", "4"], [list: "3", "1", "2", "4"], g) 
    is true
  is-valid-tour-on-path("1", [list: "4"], [list: "1", "2", "4"], g) 
    is true
  is-valid-tour-on-path("1", [list: "4"], [list: "2", "4"], g) 
    is false
end


fun list-up-to-elt<A>(list-ext :: List<A>, elt :: A) -> List<A>:
  doc:```given a list and an elt; returns the list up to and including elt```
  cases (List) list-ext:
    | empty => empty
    | link(f, r) =>
      if f == elt:
        [list: elt]
      else:
        link(f, list-up-to-elt(r, elt))
      end
  end
where:
  list-up-to-elt(empty, 1) is empty
  list-up-to-elt([list: 1, 2, 3, 4, 5, 6], 4) is [list: 1, 2, 3, 4]
end

provide *
provide-types *

include shared-gdrive("mst-support.arr", "14fGt9flbRDF3GKwiYWbIlet63fbwxczF")
include my-gdrive("mst-common.arr")

# DO NOT CHANGE ANYTHING ABOVE THIS LINE
#
# You may write implementation-specific tests (e.g., of helper functions)
# in this file.

import lists as L
import string-dict as SD

### Test Union Find
check "fynd":
  fynd(elt(0, some(elt(3, none)))) is=~ elt(3, none)
  fynd(elt(0, none)) is=~ elt(0, none)
end

check "union":
  elts = map(elt(_, none), range(0,4))
  union(elts.get(0), elts.get(3))
  elts is=~ [list: elt(0, some(elt(3, none))), elt(1, none), 
    elt(2, none), elt(3, none)]
  union(elts.get(0), elts.get(0)) 
  elts is=~ [list: elt(0, some(elt(3, none))), 
    elt(1, none), elt(2, none), elt(3, none)]
end

### Heaps Implementation Based on Heap Lab :)
data Heap:
  | mt
  | node(value :: Edge, left :: Heap, right :: Heap)
end

test-heap = node(edge("a", "b", 1), node(edge("c", "d", 3), 
    node(edge("e", "f", 4), mt, mt), node(edge("g", "h", 5), mt, mt)),
  node(edge("c", "d", 6), node(edge("e", "f", 7), mt, mt), 
    node(edge("g", "h", 8), mt, mt)))

fun insert(el :: Edge, h :: Heap) -> Heap:
  doc: ```Takes in a PossiblePath elt and a proper Heap h produces
       a proper Heap that has all of the elements of h and elt.```
  cases (Heap) h:
    | mt => node(el, mt, mt)
    | node(v,l,r) =>
      if el.weight > v.weight:
        node(v, insert(el, r), l)
      else:
        node(el, insert(v, r), l)
      end
  end
where:
  insert(edge("a", "b", 1), mt) is node(edge("a", "b", 1), mt, mt)
  insert(edge("z", "x", 20), test-heap) is node(edge("a", "b", 1), 
    node(edge("c", "d", 6), node(edge("g", "h", 8), node(edge("z", "x", 20), 
          mt, mt), mt), node(edge("e", "f", 7), mt, mt)), 
    node(edge("c", "d", 3), node(edge("e", "f", 4), mt, mt), node(edge("g", "h",
          5), mt, mt)))
  insert(edge("A", "B", 0), node(edge("a", "b", 1), mt, mt)) is node(edge("A", 
      "B", 0), node(edge("a", "b", 1), mt, mt), mt)
end

fun remove-min(h :: Heap%(is-node)) -> Heap:
  doc: ```Given a proper, non-empty Heap h, removes its minimum element.```
  amputated = amputate-bottom-left(h)
  cases (Heap) amputated.heap:
    | mt => mt
    | node(v,l,r) =>
      reorder(rebalance(node(amputated.elt, l, r)))
  end
where:
  remove-min(test-heap) is node(edge("c", "d", 3), node(edge("c", "d", 6), 
      node(edge("e", "f", 7), mt, mt), node(edge("g", "h", 8), mt, mt)), 
    node(edge("e", "f", 4), node(edge("g", "h", 5), mt, mt), mt))
end

fun rebalance(h :: Heap) -> Heap:
  doc: ```Given a Heap h, switches all children along the leftmost path```
  cases (Heap) h:
    | mt => mt
    | node(v,l,r) => node(v,r,rebalance(l))
  end
where:
  rebalance(node(edge("c", "d", 3), node(edge("c", "d", 6), 
        node(edge("e", "f", 7), mt, mt), mt), mt))
    is node(edge("c", "d", 3), mt, node(edge("c", "d", 6), mt, 
      node(edge("e", "f", 7), mt, mt)))
  rebalance(node(edge("c", "d", 3), mt, node(edge("c", "d", 6), mt, 
        node(edge("e", "f", 7), mt, mt))))
    is node(edge("c", "d", 3), node(edge("c", "d", 6), mt, 
      node(edge("e", "f", 7), mt, mt)), mt)
end

fun get-min(h :: Heap%(is-node)) -> Edge:
  doc: ```Takes in a proper, non-empty Heap h and produces the
       minimum weight in h.```
  cases (Heap) h:
    | mt => raise("Invalid input: empty heap")
    | node(val,_,_) => val
  end
where:
  get-min(test-heap) is edge("a", "b", 1)
end

data Amputated:
  | elt-and-heap(elt :: Edge, heap :: Heap)
end

fun amputate-bottom-left(h :: Heap%(is-node)) -> Amputated:
  doc: ```Given a Heap h, produes an Amputated that contains the
       bottom-left element of h, and h with the bottom-left element removed.```
  cases (Heap) h:
    | mt => raise("Invalid input: empty heap")
    | node(value, left, right) =>
      cases (Heap) left:
        | mt => elt-and-heap(value, mt)
        | node(_, _, _) =>
          rec-amputated = amputate-bottom-left(left)
          elt-and-heap(rec-amputated.elt,
            node(value, rec-amputated.heap, right))
      end
  end
where:
  amputate-bottom-left(test-heap) is elt-and-heap(edge("e", "f", 4), 
    node(edge("a", "b", 1), node(edge("c", "d", 3), mt, node(edge("g", "h", 5), 
          mt, mt)), node(edge("c", "d", 6), node(edge("e", "f", 7), mt, mt), 
        node(edge("g", "h", 8), mt, mt))))
end

fun reorder(h :: Heap) -> Heap:
  doc: ```Given a Heap h, where only the top node is misplaced,
       produces a Heap with the same elements but in proper order.```
  cases(Heap) h:
    | mt => mt
    | node(val, lh, rh) =>
      cases(Heap) lh:
        | mt => node(val, mt, mt)
        | node(lval, llh, lrh) =>
          cases(Heap) rh:
            | mt =>
              if val.weight < lval.weight:
                node(val, node(lval, mt, mt), mt)
              else:
                node(lval, node(val, mt, mt), mt)
              end
            | node(rval, rlh, rrh) =>
              if lval.weight <= rval.weight:
                if val.weight <= lval.weight:
                  h
                else:
                  node(lval, reorder(node(val, llh, lrh)), rh)
                end
              else:
                if val.weight <= rval.weight:
                  h
                else:
                  node(rval, lh, reorder(node(val, rlh, rrh)))
                end
              end
          end
      end
  end
where:
  reorder(mt) is mt
  reorder(test-heap) is test-heap
  reorder(node(edge("a", "b", 20), node(edge("c", "d", 3), 
        node(edge("e", "f", 4), mt, mt), node(edge("g", "h", 5), mt, mt)),
      node(edge("c", "d", 6), node(edge("e", "f", 7), mt, mt), 
        node(edge("g", "h", 8), mt, mt)))) is node(edge("c", "d", 3), 
    node(edge("e", "f", 4), node(edge("a", "b", 20), mt, mt), 
      node(edge("g", "h", 5), mt, mt)), node(edge("c", "d", 6), 
      node(edge("e", "f", 7), mt, mt), node(edge("g", "h", 8), mt, mt)))
end

### Helper Functions ###
fun adj-list-build(graph :: Graph) -> StringDict<List<Edge>>:
  doc:```consumes a graph; returns a string dictionary with nodes as keys
      and an adjacency list as values```
  for fold(adj-list from mt-dict, curr-edge from graph):
    so-far-a = adj-list.get(curr-edge.a)
    so-far-b = adj-list.get(curr-edge.b)
    ask:
      | (so-far-a == none) and (so-far-b == none) then:
        adj-list.set(curr-edge.a, [list: curr-edge]).set(curr-edge.b, 
          [list: curr-edge])
      | so-far-a == none then:
        adj-list.set(curr-edge.a, [list: curr-edge]).set(curr-edge.b, 
          link(curr-edge, so-far-b.value))
      | so-far-b == none then:
        adj-list.set(curr-edge.b, [list: curr-edge]).set(curr-edge.a, 
          link(curr-edge, so-far-a.value))
      | otherwise:
        adj-list.set(curr-edge.a, link(curr-edge, so-far-a.value)).set(
          curr-edge.b, link(curr-edge, so-far-b.value))
    end
  end
where:
  adj-list-build(empty) is mt-dict
  adj-list-build([list: edge("a", "b", 10), edge("a", "b", 3), 
      edge("c", "a", 3)])
    is [string-dict: "a", [list: edge("c", "a", 3), edge("a", "b", 3), 
      edge("a", "b", 10)], "b", [list: edge("a", "b", 3), edge("a", "b", 10)], 
    "c", [list: edge("c", "a", 3)]]
  adj-list-build([list: edge("a", "b", 10), edge("a", "b", -2)]) 
    is [string-dict: "a", [list: edge("a", "b", -2), edge("a", "b", 10)], "b", 
    [list: edge("a", "b", -2), edge("a", "b", 10)]]
end

fun prim-helper(building :: List<Edge>, queue :: Heap, solution :: Set<String>,
    adj-list :: StringDict<Edge>) -> List<Edge>:
  doc:```consumes a building solution, solution so far, adjacency list, and a 
      queue; returns the edges in the MST```
  cases (Heap) queue:
    | mt => building
    | node(_, _, _) =>
      next-edge = get-min(queue)
      if solution.member(next-edge.a) and solution.member(next-edge.b):
        prim-helper(building, remove-min(queue), solution, adj-list)
      else if solution.member(next-edge.a):
        new-queue = fold({(acc, x): insert(x, acc)}, remove-min(queue), 
          adj-list.get-value(next-edge.b))
        prim-helper(link(next-edge, building), new-queue, 
          solution.add(next-edge.b), adj-list)
      else:
        new-queue = fold({(acc, x): insert(x, acc)}, remove-min(queue), 
          adj-list.get-value(next-edge.a))
        prim-helper(link(next-edge, building), new-queue, 
          solution.add(next-edge.a), adj-list)
      end
  end
where:
  prim-helper(empty, node(edge("a", "b", 1), mt, mt), [set: "a"], 
    adj-list-build([list: edge("a", "b", 1)])) is [list: edge("a", "b", 1)]
  prim-helper(empty, node(edge("a", "b", -2), node(edge("a", "b", 10), mt, mt), 
      mt), [set: "a"], adj-list-build([list: edge("a", "b", 10), edge("a", 
          "b", -2)])) is [list: edge("a", "b", -2)]
end

fun graph-builder(to-add :: List<String>, solution :: List<String>) -> Graph:
  doc:```consumes nodes to add, and nodes already added; returns a random graph 
      with all nodes```
  cases (List) to-add:
    | empty => empty
    | link(f, r) =>
      sol-size = solution.length()
      edges = for fold(b from empty, idx from L.shuffle(range(0, num-random(
                sol-size) + 1))):
        for fold(build from b, idx2 from range(0, num-random(4) + 1)):
          link(edge(f, solution.get(idx), num-random(11) - 5), build)
        end
      end
      edges.append(graph-builder(r, link(f, solution)))
  end
where:
  graph-builder([list: "b", "c", "d"], [list: "a"]) 
    satisfies {(x): x.length() <= 18}
  graph-builder([list: "b", "c", "d"], [list: "a"]) 
    satisfies {(x): x.length() >= 3}
end

check "find-nodes":
  find-nodes(empty) is empty
  find-nodes([list: edge("a", "b", 1), edge("a", "b", 3), edge("b", "c", 4)])
    is [list: "c", "a", "b"]
end

### Main Functions ###

fun mst-kruskal(graph :: Graph) -> List<Edge>:
  doc:```consumes a graph; returns a minimal spanning tree using 
      kruskals algorithm```
  sorted-edges = graph.sort-by({(x, y): x.weight < y.weight}, 
    {(x, y): x.weight == y.weight})
  unique-nodes = find-nodes(sorted-edges)
  groups = fold({(acc, x): acc.set(x, elt(x, none))}, mt-dict, unique-nodes)
  for fold(edges from empty, curr-edge from sorted-edges):
    e1 = fynd(groups.get-value(curr-edge.a))
    e2 = fynd(groups.get-value(curr-edge.b))
    if not(e1 == e2):
      block:
        union(e1, e2)
        link(curr-edge, edges)
      end
    else:
      edges
    end
  end
end

fun mst-prim(graph :: Graph) -> List<Edge>:
  doc:```consumes a graph; returns a minimal spanning tree using
      prims algorithm```
  unique-nodes = L.distinct(fold({(acc, x): link(x.a, link(x.b, acc))}, empty,
      graph))
  adj-list = adj-list-build(graph)
  if graph == empty:
    empty
  else:
    queue = fold({(acc, x): insert(x, acc)}, mt, 
      adj-list.get-value(unique-nodes.first))
    prim-helper(empty, queue, [tree-set: unique-nodes.first], adj-list)
  end
end

fun generate-input(num-vertices :: Number) -> Graph:
  doc:```consumes a number; returns a random graph with that many vertices```
  if [set: 0, 1].member(num-vertices):
    empty
  else:
    nodes = map(string-from-code-point, range(97, 97 + num-vertices))
    graph-builder(nodes.rest, [list: nodes.first])
  end
end

fun mst-cmp(
    graph :: Graph,
    mst-alg-a :: (Graph -> List<Edge>),
    mst-alg-b :: (Graph -> List<Edge>))
  -> Boolean:
  doc:```consumes two mst algorithms and determines if they both produce a valid
      mst result```
  tree1 = mst-alg-a(graph)
  tree2 = mst-alg-b(graph)
  if ((tree1 == empty) and (tree2 == empty)) and (graph == empty):
    true
  else:
    graph-nodes = find-nodes(graph).sort()
    # check spanning as having all nodes as graph in solution
    spanning = (find-nodes(tree1).sort() == graph-nodes) and (find-nodes(
        tree2).sort() == graph-nodes)

    # is-tree by measuring number of edges is one less total nodes 
    tree = (tree1.length() == (graph-nodes.length() - 1)) and (tree2.
      length() == (graph-nodes.length() - 1))

    # calculate weight by summing weights over all edges and outputing result
    weight-calc = lam(x :: Graph): fold({(acc, y): acc + y.weight}, 0, x) end
    weight = (weight-calc(tree1) == weight-calc(tree2))

    # check all tree edges are members of the graph
    edges-cont = lam(x :: Graph): L.all(graph.member(_), x) end
    edges = (edges-cont(tree1) and edges-cont(tree2))

    edges and (weight and (tree and spanning))
  end
end

fun sort-o-cle(
    mst-alg-a :: (Graph -> List<Edge>),
    mst-alg-b :: (Graph -> List<Edge>))
  -> Boolean:
  doc:```consumes two mst algorithms and determines if they are valid
      by checking if their results ober a large sample space are equal```
  random-suite = map({(_): generate-input(num-random(15))}, range(0, 30))
  rand-res = L.all(mst-cmp(_, mst-alg-a, mst-alg-b), random-suite)
  
  edge-suite = [list: two-e-two-n, tree-graph, pos-sym-cycle, neg-sym-cycle, 
    pos-cycle, neg-cycle, disj-two-mult, disj-two-back, two-cycle-inter, 
    two-cycle-inter-amb, single-edge, two-e-two-n-same, empty]
  edge-res = L.all(mst-cmp(_, mst-alg-a, mst-alg-b), edge-suite)
  
  rand-res and edge-res
end

Their 'common code'

provide *
provide-types *

include shared-gdrive("mst-support.arr", "14fGt9flbRDF3GKwiYWbIlet63fbwxczF")

# DO NOT CHANGE ANYTHING ABOVE THIS LINE
#
# Write data bindings here that you'll need for tests in both mst-code.arr
# and mst-tests.arr

import lists as L
import string-dict as SD
type StringDict = SD.StringDict
string-dict = SD.string-dict

mt-dict = [string-dict: ]

### Union Find ###
data Elt: elt(v, ref parent :: Option<Elt>) end

fun fynd(e :: Elt) -> Elt:
  doc:```finds the source elt of an elt```
  cases (Option) e!parent:
    | none => e
    | some(p) =>
      block:
        new-parent = fynd(p)
        e!{parent: some(new-parent)}
        new-parent
      end
  end
end

fun union(e1 :: Elt, e2 :: Elt):
  doc:```unions two sets together in place```
  e1n = fynd(e1)
  e2n = fynd(e2)
  when not(e1 <=> e2):
    e1n!{parent: some(e2n)}
  end
end

### find nodes helper

fun find-nodes(graph :: Graph) -> List<String>:
  doc:```consumes a graph; returns the unique nodes it has```
  L.distinct(fold({(acc, x): link(x.a, link(x.b, acc))}, empty,
      graph))
end

### TESTING GRAPHS

## Lst same els implementation from map reduce. 
# Tests removed as they break exemplar

# count
fun count<A>(target :: A, a :: List<A>, eq-checker :: (A, A -> Boolean))
  -> Number:
  doc: "counts quantity of target in a"
  fun el-checker(el, cnt):
    if eq-checker(el, target):
      cnt + 1
    else:
      cnt
    end
  end
  a.foldl(el-checker, 0)
end

# lst-same-els
fun lst-same-els<A>(a :: List<A>,b :: List<A>, eq-checker :: (A, A -> Boolean))
  -> Boolean:
  doc: "checks whether two lists have the same elements in the same quantity"
  fun same-count(el, acc):
    acc and (count(el, a, eq-checker) == count(el, b, eq-checker))
  end
  (a.length() == b.length()) and a.foldl(same-count, true)
end

## Special Graphs

# two edges two nodes
two-e-two-n = [list: edge("a", "b", 1), edge("a", "b", 3)]

# already a tree
tree-graph = [list: edge("a", "b", 1), edge("b", "c", 2), edge("a", "d", 1)]

# symmetric cycle
pos-sym-cycle = [list: edge("a", "b", 2), edge("b", "c", 2), edge("c", "d", 2), 
  edge("d", "a", 2)]

# symmetric neg cycle
neg-sym-cycle = [list: edge("a", "b", -2), edge("b", "c", -2), 
  edge("c", "d", -2), edge("d", "a", -2)]

# non-sym cycle
pos-cycle = [list: edge("a", "b", 2), edge("b", "c", 3), edge("c", "d", 2), 
  edge("d", "a", 2)]

# negative non-sym cycle
neg-cycle = [list: edge("a", "b", -2), edge("b", "c", -3), edge("c", "d", -4), 
  edge("d", "a", -5)]

# disjoint two multiple possiblities 
disj-two-mult = [list: edge("a", "b", 2), edge("a", "c", 2), edge("b", "d", 2),
  edge("c", "d", 2), edge("d", "e", 2), edge("d", "f", 2), edge("e", "g", 2),
  edge("f", "g", 2)]

# disjoint approach from back
disj-two-back = [list: edge("a", "b", 3), edge("a", "c", 3), edge("b", "d", 2),
  edge("c", "d", 2), edge("d", "e", 3), edge("d", "f", 3), edge("e", "g", 2),
  edge("f", "g", 2)]

# interpolate two cycles
two-cycle-inter = [list: edge("a", "b", 2), edge("a", "b", -1), 
  edge("b", "c", 2), edge("b", "c", 3), edge("c", "a", 4), edge("c", "a", 6)]

# interpolate two cycles ambiguous
two-cycle-inter-amb = [list: edge("a", "b", 2), edge("a", "b", -1), 
  edge("b", "c", 2), edge("b", "c", 3), edge("c", "a", 2), edge("c", "a", 2)]

# single edge
single-edge = [list: edge("a", "b", 0)]

# two edges two nodes same weight
two-e-two-n-same = [list: edge("a", "b", 1), edge("a", "b", 3)]


### BAD MST IMPLEMENTATIONS

# empty returner
empty-mst = {(x): empty}

# return first element
fun first-mst(graph :: Graph) -> List<Edge>:
  doc:```returns first edge if it exists```
  cases (List) graph:
    | empty => empty
    | link(f, r) => [list: f]
  end
end

# return random selection
fun random-mst(graph :: Graph) -> List<Edge>:
  doc:```returns random subset of edges```
  g-size = graph.length()
  L.shuffle(graph).take(num-random(g-size))
end

# return n-1 lowest edges
fun naive-kruskal-mst(graph :: Graph) -> List<Edge>:
  doc: ```returns the n-1 lowest edge weights```
  cases (List) graph:
    | empty => empty
    | link(f, r) =>
      g-size = graph.length()
      graph.sort-by({(x, y): x.weight < y.weight}, {(x, y): x.weight == 
          y.weight}).take(g-size - 1)
  end
end

# labeling flipped
fun flipped-kruskal-mst(graph :: Graph) -> List<Edge>:
  doc:```consumes a graph; returns a minimal spanning tree using 
      kruskals algorithm but reverses edges labelling```
  sorted-edges = graph.sort-by({(x, y): x.weight < y.weight}, 
    {(x, y): x.weight == y.weight})
  unique-nodes = find-nodes(sorted-edges)
  groups = fold({(acc, x): acc.set(x, elt(x, none))}, mt-dict, unique-nodes)
  for fold(edges from empty, curr-edge from sorted-edges):
    e1 = fynd(groups.get-value(curr-edge.a))
    e2 = fynd(groups.get-value(curr-edge.b))
    if not(e1 == e2):
      block:
        union(e1, e2)
        link(edge(curr-edge.b, curr-edge.a, curr-edge.weight), edges)
      end
    else:
      edges
    end
  end
end

Their tests

include shared-gdrive("mst-support.arr", "14fGt9flbRDF3GKwiYWbIlet63fbwxczF")
include my-gdrive("mst-code.arr")
include my-gdrive("mst-common.arr")

# DO NOT CHANGE ANYTHING ABOVE THIS LINE
#
# Write your examples and tests in here. These should not be tests of
# implementation-specific details (e.g., helper functions).

import lists as L

# equality operator
eq = lam(x,y): x == y end

### MST KRUSKAL

check "mst-kruskal base case sensitivity":
  # empty test
  mst-kruskal(empty) is empty

  # singular edge
  mst-kruskal(single-edge) is single-edge
end

check "mst-kruskal multiple edge sensitivity":
  # two nodes two edges
  mst-kruskal(two-e-two-n) is [list: edge("a", "b", 1)]

  # two edges two nodes same weight
  mst-kruskal(two-e-two-n-same) is [list: edge("a", "b", 1)]

  # traverse interpolated cycles
  mst-kruskal(two-cycle-inter) satisfies lst-same-els(_, [list: edge("b", "c", 
        2), edge("a", "b", -1)], eq)
end

check "mst-kruskal properly traverses":
  # traverse a tree
  mst-kruskal(tree-graph) satisfies lst-same-els(_, tree-graph, eq)

  # traverse non-sym cycle
  mst-kruskal(pos-cycle) satisfies lst-same-els(_, [list: edge("a", "b", 2),
      edge("c", "d", 2), edge("d", "a", 2)], eq)

  # traverse non-sym negative cycle
  mst-kruskal(neg-cycle) satisfies lst-same-els(_, [list: edge("b", "c", -3), 
      edge("c", "d", -4), edge("d", "a", -5)], eq)
end

check "mst-kruskal ambiguous manually checked":
  # symmetric cycle
  mst-kruskal(pos-sym-cycle) satisfies {(x): L.any(lam(y): lst-same-els(x, y, 
        eq) end, [list: [list: edge("a", "b", 2), edge("b", "c", 2), 
          edge("c", "d", 2)],[list: edge("b", "c", 2), edge("c", "d", 2), 
          edge("d", "a", 2)]])}

  # symmetric neg cycle
  mst-kruskal(neg-sym-cycle) satisfies {(x): L.any(lam(y): lst-same-els(x, y, 
        eq) end, [list: [list: edge("a", "b", -2), edge("b", "c", -2), 
          edge("c", "d", -2)],[list: edge("b", "c", -2), edge("c", "d", -2), 
          edge("d", "a", -2)]])}

  # disjoint two possibilities approach back
  mst-kruskal(disj-two-back) satisfies {(x): L.any(lam(y): lst-same-els(x, y, 
        eq) end, [list: [list: edge("a", "b", 3), edge("b", "d", 2), 
          edge("c", "d", 2), edge("d", "e", 3), edge("e", "g", 2), 
          edge("f", "g", 2)], 
        [list: edge("a", "c", 3), edge("b", "d", 2), edge("c", "d", 2), 
          edge("d", "f", 3), edge("e", "g", 2), edge("f", "g", 2)],
        [list: edge("a", "b", 3), edge("b", "d", 2), edge("c", "d", 2),  
          edge("d", "f", 3), edge("e", "g", 2), edge("f", "g", 2)],
        [list: edge("a", "c", 3), edge("b", "d", 2), edge("c", "d", 2), 
          edge("d", "e", 3), edge("e", "g", 2), edge("f", "g", 2)]])}
end


### MST PRIM

check "mst-prim base case sensitivity":
  # empty test
  mst-prim(empty) is empty

  # singular edge
  mst-prim(single-edge) is single-edge
end

check "mst-prim multiple edge sensitivity":
  # two notes two edges
  mst-prim(two-e-two-n) is [list: edge("a", "b", 1)]

  # two edges two nodes same weight
  mst-prim(two-e-two-n-same) is [list: edge("a", "b", 1)]

  # traverse interpolated cycles
  mst-prim(two-cycle-inter) satisfies lst-same-els(_, [list: edge("b", "c", 
        2), edge("a", "b", -1)], eq)
end

check "mst-prim properly traverses":
  # traverse a tree
  mst-prim(tree-graph) satisfies lst-same-els(_, tree-graph, eq)

  # traverse non-sym cycle
  mst-prim(pos-cycle) satisfies lst-same-els(_, [list: edge("a", "b", 2),
      edge("c", "d", 2), edge("d", "a", 2)], eq)

  # traverse non-sym negative cycle
  mst-prim(neg-cycle) satisfies lst-same-els(_, [list: edge("b", "c", -3), 
      edge("c", "d", -4), edge("d", "a", -5)], eq)
end

check "mst-kruskal ambiguous manually checked":
  # symmetric cycle
  mst-prim(pos-sym-cycle) satisfies {(x): L.any(lam(y): lst-same-els(x, y, 
        eq) end, [list: [list: edge("a", "b", 2), edge("b", "c", 2), 
          edge("c", "d", 2)],[list: edge("b", "c", 2), edge("c", "d", 2), 
          edge("d", "a", 2)]])}

  # symmetric neg cycle
  mst-prim(neg-sym-cycle) satisfies {(x): L.any(lam(y): lst-same-els(x, y, 
        eq) end, [list: [list: edge("a", "b", -2), edge("b", "c", -2), 
          edge("c", "d", -2)],[list: edge("b", "c", -2), edge("c", "d", -2), 
          edge("d", "a", -2)]])}

  # disjoint two possibilities approach back
  mst-prim(disj-two-back) satisfies {(x): L.any(lam(y): lst-same-els(x, y, 
        eq) end, [list: [list: edge("a", "b", 3), edge("b", "d", 2), 
          edge("c", "d", 2), edge("d", "e", 3), edge("e", "g", 2), 
          edge("f", "g", 2)], 
        [list: edge("a", "c", 3), edge("b", "d", 2), edge("c", "d", 2), 
          edge("d", "f", 3), edge("e", "g", 2), edge("f", "g", 2)],
        [list: edge("a", "b", 3), edge("b", "d", 2), edge("c", "d", 2),  
          edge("d", "f", 3), edge("e", "g", 2), edge("f", "g", 2)],
        [list: edge("a", "c", 3), edge("b", "d", 2), edge("c", "d", 2), 
          edge("d", "e", 3), edge("e", "g", 2), edge("f", "g", 2)]])}
end


### GENERATE INPUT

check "generate-input base case":
  # empty graph 0
  generate-input(0) is empty

  # empty graph 1
  generate-input(1) is empty
end

check "generate-input size":
  # check over large space
  fold({(acc1, y): link(L.distinct(fold({(acc, x): link(x.a, link(x.b, acc))}, 
            empty, generate-input(y))).length(), acc1)}, empty, range(2, 30))
    is range(2, 30).reverse()
end

check "generate-input connectedness":
  # the connected condition means that there must be >= n - 1 unique edges
  input-g = map({(_): generate-input(num-random(15) + 15)}, range(0, 10))
  dist-ed = map({(y): L.distinct(map({(x): {x.a; x.b}}, y))}, input-g)
  dist-ed satisfies L.all({(y): y.length() >= (L.distinct(fold({(acc, x): 
              link(x.{0}, link(x.{1}, acc))}, empty, y)).length() - 1)}, _)
end

check "generate-input no loops":
  # check no a -> a
  input-g = map({(_): generate-input(num-random(15) + 15)}, range(0, 10))
  input-g satisfies L.all({(y): L.all(lam(x): not(x.a == x.b) end, y)}, _)
end

check "generate-input unidirectional":
  # check that if a -> b no b -> a
  input-g = map({(_): generate-input(num-random(15) + 15)}, range(0, 10))
  dist-ed = map({(y): L.distinct(map({(x): {x.a; x.b}}, y))}, input-g)
  dist-ed satisfies L.all({(y): L.all(lam(x): not(y.member({x.{1}; x.{0}})) end,
        y)}, _)
end


### MST CMP

check "mst-cmp base case":
  # empty graph correct implementations 
  empty satisfies mst-cmp(_, mst-prim, mst-kruskal)

  # empty graph false implementation but still correct
  empty satisfies mst-cmp(_, mst-prim, empty-mst)
end

check "mst-cmp correct implementations deterministic graphs":
  # two notes two edges
  two-e-two-n satisfies mst-cmp(_, mst-prim, mst-kruskal)

  # two edges two nodes same weight
  two-e-two-n-same satisfies mst-cmp(_, mst-prim, mst-kruskal)

  # traverse interpolated cycles
  two-cycle-inter satisfies mst-cmp(_, mst-prim, mst-kruskal)

  # traverse a tree
  tree-graph satisfies mst-cmp(_, mst-prim, mst-kruskal)

  # traverse non-sym cycle
  pos-cycle satisfies mst-cmp(_, mst-prim, mst-kruskal)

  # traverse non-sym negative cycle
  neg-cycle satisfies mst-cmp(_, mst-prim, mst-kruskal)
end

check "mst-cmp correct implementations non-deterministic":
  # positive symetric cycle
  pos-sym-cycle satisfies mst-cmp(_, mst-prim, mst-kruskal)

  # negative symetric cycle
  neg-sym-cycle satisfies mst-cmp(_, mst-prim, mst-kruskal)

  # disjoint two parts multiple paths
  disj-two-mult satisfies mst-cmp(_, mst-prim, mst-kruskal)

  # disjoint multiple paths with backtracking
  disj-two-back satisfies mst-cmp(_, mst-prim, mst-kruskal)

  # two cycles interpolated ambiguous
  two-cycle-inter-amb satisfies mst-cmp(_, mst-prim, mst-kruskal)
end

check "mst-cmp failing implementations but same output":
  # both return empty
  two-e-two-n violates mst-cmp(_, empty-mst, empty-mst)
  
  # both return one edge in the graph
  tree-graph violates {(x): mst-cmp(x, first-mst, first-mst)}
end

check "mst-cmp failing specific criteria":
  # makes sure mst-cmp can weed out random
  disj-two-mult violates {(x): L.all({(y): mst-cmp(x, random-mst, mst-prim)}, 
      range(0, 10))}
  
  # weights off
  pos-cycle violates mst-cmp(_, mst-kruskal, {(x): [list: edge("b", "c", 3), 
        edge("c", "d", 2), edge("d", "a", 2)]})
  
  # spanning off
  pos-sym-cycle violates mst-cmp(_, mst-kruskal, {(x): [list: edge("a", "b", 2),
        edge("b", "c", 2), edge("b", "c", 2)]})
  
  # tree off
  single-edge violates mst-cmp(_, mst-kruskal, {(x): [list: edge("a", "b", 0),
        edge("a", "b", 0)]})
  
  # inclusion off
  pos-cycle violates mst-cmp(_, mst-kruskal, {(x): [list: edge("b", "c", -5), 
        edge("c", "d", -5), edge("d", "a", 17)]})
end

### SORT-O-CLE

check "sort-o-cle both valid":
  # mst-prim and mst-kruskal should be correct
  sort-o-cle(mst-prim, mst-kruskal) is true
end

check "sort-o-cle one valid":
  # mst-prim up against only empty
  empty-mst violates sort-o-cle(_, mst-prim)
  
  # first element
  first-mst violates sort-o-cle(_, mst-kruskal)
  
  # random
  random-mst violates sort-o-cle(_, mst-prim)
  
  # naive-kruskal
  naive-kruskal-mst violates sort-o-cle(_, mst-kruskal)
  
  # flipped edge labeling
  flipped-kruskal-mst violates sort-o-cle(_, mst-kruskal)
end

check "sort-o-cle input two wrong":
  sort-o-cle(empty-mst, first-mst) is false
  
  sort-o-cle(first-mst, random-mst) is false
  
  sort-o-cle(naive-kruskal-mst, flipped-kruskal-mst) is false
end

provide *

include shared-gdrive("fluid-images-definitions.arr", "1qYtcBi1vQUhOZSgCyqLGv8GTJaWxypaL")

import image-url,
image-width,
image-height,
image-to-color-list,
color-list-to-image
from image

import image-structs as I

fun run-on-url(url :: String, func :: (Image, Number -> Image), n :: Number):
  doc: ```Runs one of your Fluid Images implementations on an image
       downloaded from a url```
  fl-image :: Image =
    let raw-image = image-url(url),
      width       = image-width(raw-image),
      height      = image-height(raw-image),
      image-data  = image-to-color-list(raw-image):
      image-data.map({(c):color(c.red, c.green, c.blue)})
        ^ builtins.raw-array-from-list
        ^ image(width,height).make
    end
  liquified = func(fl-image, n)
  im-list = lists.fold({(acc, cur): acc.append(cur)}, empty, liquified.pixels)
  im-list-colors = im-list.map({(e): I.color(e.red, e.green, e.blue, 1)})
  color-list-to-image(im-list-colors, liquified.width, liquified.height, 0, 0)
end

import string-dict as SD
type StringDict = SD.StringDict
string-dict = SD.string-dict

### DATA DEFINITIONS
data SearchRet: ret(weight :: Number, path :: List<Number>) end
data Mem: mem(in :: List<List<Number>>, out :: List<List<SearchRet>>) end

### HELPER FUNCTIONS
fun calculate-brightness(in :: Color) -> Number:
  doc:```computes the brightness of a color```
  in.red + in.green + in.blue
where:
  calculate-brightness(color(1, 2, 3)) is 6
  calculate-brightness(color(0, 0, 0)) is 0
  calculate-brightness(color(34, 24, 90)) is 148
end

fun image-brightness(im :: Image) -> List<List<Number>>:
  doc:```computes the brightness of an entire image```
  pixels = im.pixels
  height = im.height
  width = im.width
  for fold(x-arr from empty, row from range(0, height + 2)):
    link(
      for fold(y-arr from empty, col from range(0, width + 2)):
        ask:
          | (row == 0) or (row == (height + 1)) then:
            link(0, y-arr)
          | (col == 0) or (col == (width + 1)) then:
            link(0, y-arr)
          | otherwise:
            link(calculate-brightness(pixels.get(row - 1).get(col -  1)), 
              y-arr)
        end
      end.reverse(), x-arr)
  end.reverse()
where:
  image-brightness([image(3,2): color(0,2,0), color(0,0,0),  color(0,3,0), 
      color(1,0,0), color(0,3,0),  color(0,0,4)])
    is [list: [list: 0, 0, 0, 0, 0], [list: 0, 2, 0, 3, 0], [list: 0, 1, 3, 4, 
      0], [list: 0, 0, 0, 0, 0]]
  image-brightness([image(1,1): color(133, 1, 45)]) is [list: [list: 0, 0, 0], 
    [list: 0, 179, 0], [list: 0, 0, 0]]
  image-brightness(image6) is [list: [list: 0, 0, 0, 0, 0, 0], [list: 0, 1, 9, 
      3, 6, 0], [list: 0, 0, 0, 0, 0, 0]]
end

fun energy(im :: Image) -> List<List<Number>>:
  doc:```computes the energy of each element```
  bright = image-brightness(im)
  height = im.height
  width = im.width
  for fold(x-arr from empty, row from range(1, height + 1)):
    link(
      for fold(y-arr from empty, col from range(1, width + 1)):
        x-energy = (((((bright.get(row - 1).get(col - 1) + (2 * bright.get(row)
                      .get(col - 1))) + bright.get(row + 1).get(col - 1)) - 
              bright.get(row - 1).get(col + 1)) - (2 * bright.get(row).get(col 
                  + 1))) - bright.get(row + 1).get(col + 1))

        y-energy = (((((bright.get(row - 1).get(col - 1) + (2 * bright.get(row 
                        - 1).get(col))) + bright.get(row - 1).get(col + 1)) - 
              bright.get(row + 1).get(col - 1)) - (2 * bright.get(row + 1).
              get(col))) - bright.get(row + 1).get(col + 1))

        link(num-sqrt(num-sqr(x-energy) + num-sqr(y-energy)), y-arr)
      end.reverse(), x-arr)
  end.reverse()
where:
  energy([image(3,2): color(0,2,0), color(0,0,0),  color(0,3,0), 
      color(1,0,0), color(0,3,0),  color(0,0,4)]) 
    is%(within(0.001)) [list: [list: ~5.83095, ~12.08304, ~11.40175], [list: 
      ~7.21110, ~8.60232, ~8.48528]]
  energy([image(1,1): color(133, 1, 45)]) is%(within(0.001)) [list: [list: 0]]
  energy([image(2, 2): color(1,1,1), color(1,0,2), color(2,0,1), color(0,3,0)])
    is%(within(0.0001)) [list: [list: ~12.72792, ~12.72792], [list: ~12.72792, 
      ~12.72792]]
  energy(rand-image) 
    is%(within(0.0001)) [list: [list: ~1676.70450, ~2084.75082, ~2125.71493, 
        ~1962.29457], [list: ~2162.65068, ~704.82480, ~178.31432, ~1656.33631], 
      [list: ~1940.31801, ~1988.38879, ~2120.82436, ~1801.16073]]
end

# cannot test this function
fun memoize(liquify :: (List<List<Number>> -> List<List<SearchRet>>)) 
  -> (List<List<Number>> -> List<List<SearchRet>>):
  doc:```consumes a liquifier and memoizes it```
  var memory = empty
  lam(compute :: List<List<Number>>) block:
    thresh = within(0.0001)
    re = find({(m :: Mem): thresh(m.in, compute)}, memory)
    cases (Option) re block:
      | some(v) => v.out
      | none =>
        actual = liquify(compute)
        memory := link(mem(compute, actual), memory)
        actual
    end
  end
end

rec seam :: (List<List<Number>> -> List<List<SearchRet>>) = 
  #consumes a list of a list of energies and returns the searchresults
  memoize(
    lam(compute :: List<List<Number>>):
      cases (List) compute:
        | empty => empty
        | link(f, r) =>
          before = seam(r)
          addition = for fold(acc from empty, elt from range(0, f.length())):
            ask:
              | before == empty then:
                link(ret(f.get(elt), [list: elt]), acc)
              | elt == 0 then:
                min-weight = fold({(acc1, x): if x.weight < acc1.weight: x 
                    else: acc1 end}, ret(100000000, empty), [list: before.first
                      .get(elt), before.first.get(elt + 1)])
                link(ret(f.get(elt) + min-weight.weight, link(elt, 
                      min-weight.path)), acc)
              | elt == (f.length() - 1) then:
                min-weight = fold({(acc1, x): if x.weight < acc1.weight: x 
                    else: acc1 end}, ret(100000000, empty), [list: before.first
                      .get(f.length() - 2), before.first.get(f.length() - 1)])
                link(ret(f.get(elt) + min-weight.weight, link(elt, 
                      min-weight.path)), acc)
              | otherwise:
                min-weight = fold({(acc1, x): if x.weight < acc1.weight: x 
                    else: acc1 end}, ret(100000000, empty), [list: before.first
                      .get(elt - 1), before.first.get(elt), before.first
                      .get(elt + 1)])
                link(ret(f.get(elt) + min-weight.weight, link(elt, 
                      min-weight.path)), acc)
            end
          end.reverse()
          link(addition, before)
      end
    end)

check "seam":
  seam(energy([image(3,2): color(0,2,0), color(0,0,0),  color(0,3,0), 
        color(1,0,0), color(0,3,0),  color(0,0,4)]))
    is%(within(0.0001)) [list: [list: ret(~13.04205, [list: 0, 0]), 
      ret(~19.29414, [list: 1, 0]), ret(~19.88703, [list: 2, 2])], [list: 
      ret(~7.21110, [list: 0]), ret(~8.60232, [list: 1]), ret(~8.48528, [list: 
          2])]]
  seam(energy([image(4, 3): color(100, 46, 1), color(148, 60, 109), color(210, 
          10, 153), color(114, 161, 217), color(115, 68, 96), color(235, 211, 
          143), color(249, 212, 51), color(172, 116, 209), color(180, 217, 96), 
        color(61, 243, 184), color(124, 38, 76), color(95, 83, 249)]))
    is%(within(0.0001)) [list: [list: ret(~4321.84732, [list: 0, 1, 0]), 
      ret(~4064.22589, [list: 1, 2, 3]), ret(~4105.19000, [list: 2, 2, 3]), 
      ret(~3941.76964, [list: 3, 2, 3])], [list: ret(~4102.96870, [list: 0, 0]),
      ret(~2645.14281, [list: 1, 0]), ret(~1979.47506, [list: 2, 3]), 
      ret(~3457.49705, [list: 3, 3])], [list: ret(~1940.31801, [list: 0]), 
      ret(~1988.38879, [list: 1]), ret(~2120.82436, [list: 2]), ret(~1801.16073,
        [list: 3])]]
  seam(energy([image(2, 2): color(1,1,1), color(1,0,2), color(2,0,1), 
        color(0,3,0)])) 
    is%(within(0.001)) [list: [list: ret(~25.45584, [list: 0, 0]), 
      ret(~25.45584, [list: 1, 0])], [list: ret(~12.72792, [list: 0]), 
      ret(~12.72792, [list: 1])]]
end

fun seam-DP(input :: Image) -> Image block:
  doc:```consumes an image and returns the lowest seam removed```
  height = input.height
  width = input.width
  paths = build-array({(_): array-of(none, width)}, height)
  energized = energy(input)

  for each(col from range(0, width)):
    paths.get-now(0).set-now(col, some(ret(energized.get(0).get(col), [list: 
            col])))
  end

  for each(row from range(1, height)):
    for each(col from range(0, width)):
      ask:
        | col == 0 then:
          min-weight = fold({(acc1, x): if x.weight < acc1.weight: x 
              else: acc1 end}, ret(100000000, empty), [list: paths.get-now(row 
                  - 1).get-now(col).value,  paths.get-now(row - 1).get-now(col 
                  + 1).value])
          paths.get-now(row).set-now(col, some(ret(min-weight.weight 
                  + energized.get(row).get(col), link(col, min-weight.path))))
        | col == (width - 1) then:
          min-weight = fold({(acc1, x): if x.weight < acc1.weight: x 
              else: acc1 end}, ret(100000000, empty), [list: paths.get-now(row 
                  - 1).get-now(col - 1).value, paths.get-now(row - 1)
                .get-now(col).value])
          paths.get-now(row).set-now(col, some(ret(min-weight.weight 
                  + energized.get(row).get(col), link(col, min-weight.path))))
        | otherwise:
          min-weight = fold({(acc1, x): if x.weight < acc1.weight: x 
              else: acc1 end}, ret(100000000, empty), [list: paths.get-now(row 
                  - 1).get-now(col - 1).value, paths.get-now(row - 1).get-now(
                col).value, paths.get-now(row - 1).get-now(col + 1).value])          
          paths.get-now(row).set-now(col, some(ret(min-weight.weight 
                  + energized.get(row).get(col), link(col, min-weight.path))))
      end
    end
  end

  last-row = paths.get-now(height - 1).to-list-now()
  min-path = fold({(acc1, x): 
      if x.value.weight < acc1.value.weight: 
        x 
      else if within(0.0001)(x.value.weight, acc1.value.weight):
        # if same stream value check start point
        if x.value.path.first < acc1.value.path.first:
          x
        else:
          acc1
        end
      else: 
        acc1 
      end}, last-row.first, last-row).value.path.reverse()
  pixels = input.pixels
  new-pixels = for map2(row from pixels, drop from min-path):
    row.take(drop).append(row.drop(drop + 1))
  end
  image-data-to-image(input.width - 1, input.height, 
    new-pixels)
where:
  seam-DP([image(3,2): color(0,2,0), color(0,0,0),  color(0,3,0), 
      color(1,0,0), color(0,3,0),  color(0,0,4)])
    is [image(2,2): color(0,0,0), color(0,3,0), color(0,3,0), color(0,0,4)]
  seam-DP([image(4, 3): color(100, 46, 1), color(148, 60, 109), color(210, 10, 
        153), color(114, 161, 217), color(115, 68, 96), color(235, 211, 143), 
      color(249, 212, 51), color(172, 116, 209), color(180, 217, 96), color(61,
        243, 184), color(124, 38, 76), color(95, 83, 249)])
    is [image(3,3): color(100, 46, 1), color(148, 60, 109), color(210, 10, 153),
    color(115, 68, 96), color(235, 211, 143), color(172, 116, 209), color(180, 
      217, 96), color(61, 243, 184), color(124, 38, 76)]
  seam-DP([image(2, 2): color(1,1,1), color(1,0,2), color(2,0,1), 
      color(0,3,0)]) is [image(1, 2): color(1, 0, 2), color(0, 3, 0)]
  # all streams same energy
  seam-DP(image2) is [image(1, 2): color(1, 0, 2), color(0, 3, 0)]

  # same energy streams start different place end one place
  seam-DP(image3)
    is [image(4, 3): color(0, 10, 0), color(0, 10, 0), color(0, 0, 0), 
    color(0, 10, 0), color(0, 100, 0), color(0, 10, 0), color(0, 10, 0), 
    color(0, 100, 0), color(0, 200, 0), color(0, 100, 0), color(0, 100, 0), 
    color(0, 200, 0)]

  # same energy streams start same end same diverge middle
  seam-DP(image4)
    is [image(4, 3): color(0, 20, 0), color(0, 0, 0), color(0, 0, 0), color(0, 
      20, 0), color(0, 250, 0), color(0, 100, 0), color(0, 10, 0), color(0, 250,
      0), color(0, 200, 0), color(0, 100, 0), color(0, 100, 0), color(0, 200, 
      0)]
  
  # multiple seams all disjoint
  seam-DP(image5)
    is [image(6, 3): color(0, 0, 0), color(10, 0, 0), color(0, 0, 0), 
    color(10, 0, 0), color(0, 0, 0), color(10, 0, 0), color(0, 0, 0), 
    color(10, 0, 0), color(0, 0, 0), color(10, 0, 0), color(0, 0, 0), 
    color(10, 0, 0), color(0, 0, 0), color(10, 0, 0), color(0, 0, 0), 
    color(10, 0, 0), color(0, 0, 0), color(10, 0, 0)]
end


### MAIN FUNCTIONS

fun liquify-memoization(input :: Image, n :: Number) -> Image:
  doc:```consumes an image and the number of seams to carve out; 
      returns the carved image using memoization```
  ask:
    | n == 0 then: input
    | otherwise:
      energized = energy(input)
      final-row = seam(energized).first
      min-path = fold({(acc1, x): 
          if x.weight < acc1.weight: 
            x 
          else if within(0.0001)(x.weight, acc1.weight):
            # if same stream value check start point
            if x.path.first < acc1.path.first:
              x
            else:
              acc1
            end
          else: 
            acc1 
          end}, final-row.first, final-row).path
      pixels = input.pixels
      new-pixels = for map2(row from pixels, drop from min-path):
        row.take(drop).append(row.drop(drop + 1))
      end
      liquify-memoization(image-data-to-image(input.width - 1, input.height, 
          new-pixels), n - 1)
  end
end

fun liquify-dynamic-programming(input :: Image, n :: Number) -> Image:
  doc:```consumes an image and the number of seams to carve out; 
      returns the carved image using DP```
  ask:
    | n == 0 then: input
    | otherwise: liquify-dynamic-programming(seam-DP(input), n - 1)
  end
end

Their 'common code' library

# Write data bindings here that you'll need for tests in both
# fluid-images-code.arr and fluid-images-tests.arr

### Test Images

image1 = [image(3,2): color(0,2,0), color(0,0,0), color(0,3,0), 
  color(1,0,0), color(0,3,0),  color(0,0,4)]

image2 = [image(2, 2): color(1,1,1), color(1,0,2), color(2,0,1), 
  color(0,3,0)]

image3 = [image(5, 3): color(0,10,0), color(0,0,0), color(0,10,0), 
  color(0,0,0), color(0,10,0), color(0,100,0), color(0,10,0), color(0,100,0)
  , color(0,10,0), color(0,100,0), color(0,200,0), color(0,100,0), 
  color(0,10,0), color(0,100,0), color(0,200,0)]

image4 = [image(5, 3): color(0,20,0), color(0,0,0), color(0,10,0), 
  color(0,0,0), color(0,20,0), color(0,250,0), color(0,10,0), color(0,100,0)
  , color(0,10,0), color(0,250,0), color(0,200,0), color(0,100,0), 
  color(0,250,0), color(0,100,0), color(0,200,0)]

rand-image = [image(4, 3): color(100, 46, 1), color(148, 60, 109), color(210, 
    10, 153), color(114, 161, 217), color(115, 68, 96), color(235, 211, 
    143), color(249, 212, 51), color(172, 116, 209), color(180, 217, 96), 
  color(61, 243, 184), color(124, 38, 76), color(95, 83, 249)]

image5 = [image(7, 3): color(10, 0, 0), color(0,0,0), color(10, 0, 0), 
  color(0,0,0), color(10, 0, 0), color(0,0,0), color(10, 0, 0), color(10, 0, 0)
  , color(0,0,0), color(10, 0, 0), color(0,0,0), color(10, 0, 0), color(0,0,0), 
  color(10, 0, 0), color(10, 0, 0), color(0,0,0), color(10, 0, 0), color(0,0,0),
  color(10, 0, 0), color(0,0,0), color(10, 0, 0)]

image6 = [image(4, 1): color(1,0,0), color(9,0,0), color(3,0,0), color(6,0,0)]

image7 = [image(5, 6): color(0,20,0), color(0,0,0), color(0,100,0), 
    color(0,0,0), color(0,20,0), color(0,250,0), color(100,100,100), 
  color(0,100,25), color(100,100,100), color(0,250,0), color(0,200,0), 
  color(0,100,0), color(0,250,0), color(0,100,0), color(0,200,0), color(0,20,0),
  color(0,100,0), color(0,100,0), color(0,100,0), color(0,20,0), color(0,100,0),
  color(100,100,100), color(100,0,100), color(100,100,100), color(0,100,0), 
  color(0,100,0), color(200,200,200), color(100,0,0), color(200,200,200), 
  color(0,100,0)]

Their tests

# Write your examples and tests in here. These should not be tests of
# implementation-specific details (e.g., helper functions).

### Liquify Memoization

check "liquify-memoization base case":
  # remove no seam
  liquify-memoization(image1, 0) is image1

  # vertical image no removal
  liquify-memoization([image(1,1): color(0,0,0)], 0) is [image(1,1): 
    color(0,0,0)]

  # single row
  liquify-memoization(image6, 1)
    is [image(3, 1): color(1, 0, 0), color(3, 0, 0), color(6, 0, 0)]
end

check "liquify-memoization standard removal":
  # remove one seam
  liquify-memoization(image1, 1) is [image(2,2): color(0,0,0), color(0,3,0), 
    color(0,3,0),  color(0,0,4)]
  
  # remove one from random
  liquify-memoization(rand-image, 1)
    is [image(3, 3): color(100, 46, 1), color(148, 60, 109), color(210, 10, 153)
    , color(115, 68, 96), color(235, 211, 143), color(172, 116, 209), color(180,
      217, 96), color(61, 243, 184), color(124, 38, 76)]
end

check "liquify-memoization multiple seam removal sensitivity":
  # remove two seams
  liquify-memoization(image1, 2) is [image(1,2): color(0,0,0), color(0,3,0)]

  # remove two seems from random image
  liquify-memoization(rand-image, 2) 
    is [image(2, 3): color(148, 60, 109), color(210, 10, 153), color(115, 68, 
      96), color(172, 116, 209), color(61, 243, 184), color(124, 38, 76)]

  # remove left crossing seam then take out another
  liquify-memoization(image7, 2) 
    is [image(3, 6): color(0, 0, 0), color(0, 0, 0), color(0, 20, 0), color(0, 
      250, 0), color(100, 100, 100), color(0, 250, 0), color(0, 200, 0), 
    color(0, 100, 0), color(0, 200, 0),  color(0, 20, 0), color(0, 100, 0), 
    color(0, 20, 0), color(100, 100, 100), color(100, 100, 100), color(0, 100, 
      0), color(100, 0, 0), color(200, 200, 200), color(0, 100, 0)]

  # single row multiple
  liquify-memoization(image6, 2)
    is [image(2, 1): color(3, 0, 0), color(6, 0, 0)]

  # remove all but one
  liquify-memoization(image7, 4)
    is [image(1, 6): color(0, 0, 0), color(0, 250, 0), color(0, 200, 0), 
    color(0, 20, 0), color(0, 100, 0), color(100, 0, 0)]
  
  # remove two from constant
  liquify-memoization(image5, 2)
    is [image(5, 3): color(0, 0, 0), color(0, 0, 0), color(10, 0, 0), color(0,
      0, 0), color(10, 0, 0), color(0, 0, 0), color(0, 0, 0), color(10, 0, 0), 
    color(0, 0, 0), color(10, 0, 0), color(0, 0, 0), color(0, 0, 0), color(10, 
      0, 0), color(0, 0, 0), color(10, 0, 0)]
end

check "liquify-memoization same energy sensitivity":
  # all streams same energy
  liquify-memoization(image2, 1) is [image(1, 2): color(1, 0, 2), 
    color(0, 3, 0)]

  # same energy streams start different place end one place
  liquify-memoization(image3, 1)
    is [image(4, 3): color(0, 10, 0), color(0, 10, 0), color(0, 0, 0), 
    color(0, 10, 0), color(0, 100, 0), color(0, 10, 0), color(0, 10, 0), 
    color(0, 100, 0), color(0, 200, 0), color(0, 100, 0), color(0, 100, 0), 
    color(0, 200, 0)]

  # same energy streams start same end same diverge middle
  liquify-memoization(image4, 1)
    is [image(4, 3): color(0, 20, 0), color(0, 0, 0), color(0, 0, 0), color(0, 
      20, 0), color(0, 250, 0), color(0, 100, 0), color(0, 10, 0), color(0, 250,
      0), color(0, 200, 0), color(0, 100, 0), color(0, 100, 0), color(0, 200, 
      0)]

  # multiple seams all disjoint
  liquify-memoization(image5, 1)
    is [image(6, 3): color(0, 0, 0), color(10, 0, 0), color(0, 0, 0), 
    color(10, 0, 0), color(0, 0, 0), color(10, 0, 0), color(0, 0, 0), 
    color(10, 0, 0), color(0, 0, 0), color(10, 0, 0), color(0, 0, 0), 
    color(10, 0, 0), color(0, 0, 0), color(10, 0, 0), color(0, 0, 0), 
    color(10, 0, 0), color(0, 0, 0), color(10, 0, 0)]
end

### Liquify Dynamic Programming

check "liquify-dynamic-programming base case":
  # remove no seam
  liquify-dynamic-programming(image1, 0) is image1

  # vertical image no removal
  liquify-dynamic-programming([image(1,1): color(0,0,0)], 0) is [image(1,1): 
    color(0,0,0)]

  # single row
  liquify-dynamic-programming(image6, 1)
    is [image(3, 1): color(1, 0, 0), color(3, 0, 0), color(6, 0, 0)]
end

check "liquify-dynamic-programming standard removal":
  # remove one seam
  liquify-dynamic-programming(image1, 1) is [image(2,2): color(0,0,0), 
    color(0,3,0), color(0,3,0),  color(0,0,4)]
  
  # remove one from random
  liquify-dynamic-programming(rand-image, 1)
    is [image(3, 3): color(100, 46, 1), color(148, 60, 109), color(210, 10, 153)
    , color(115, 68, 96), color(235, 211, 143), color(172, 116, 209), color(180,
      217, 96), color(61, 243, 184), color(124, 38, 76)]
end

check "liquify-dynamic-programming multiple seam removal sensitivity":
  # remove two seams
  liquify-dynamic-programming(image1, 2) is [image(1,2): color(0,0,0), 
    color(0,3,0)]

  # remove two seems from random image
  liquify-dynamic-programming(rand-image, 2) 
    is [image(2, 3): color(148, 60, 109), color(210, 10, 153), color(115, 68, 
      96), color(172, 116, 209), color(61, 243, 184), color(124, 38, 76)]

  # remove left crossing seam then take out another
  liquify-dynamic-programming(image7, 2) 
    is [image(3, 6): color(0, 0, 0), color(0, 0, 0), color(0, 20, 0), color(0, 
      250, 0), color(100, 100, 100), color(0, 250, 0), color(0, 200, 0), 
    color(0, 100, 0), color(0, 200, 0),  color(0, 20, 0), color(0, 100, 0), 
    color(0, 20, 0), color(100, 100, 100), color(100, 100, 100), color(0, 100, 
      0), color(100, 0, 0), color(200, 200, 200), color(0, 100, 0)]

  # single row multiple
  liquify-dynamic-programming(image6, 2)
    is [image(2, 1): color(3, 0, 0), color(6, 0, 0)]

  # remove all but one
  liquify-dynamic-programming(image7, 4)
    is [image(1, 6): color(0, 0, 0), color(0, 250, 0), color(0, 200, 0), 
    color(0, 20, 0), color(0, 100, 0), color(100, 0, 0)] 
  
  # remove two from constant
  liquify-dynamic-programming(image5, 2)
    is [image(5, 3): color(0, 0, 0), color(0, 0, 0), color(10, 0, 0), color(0,
      0, 0), color(10, 0, 0), color(0, 0, 0), color(0, 0, 0), color(10, 0, 0), 
    color(0, 0, 0), color(10, 0, 0), color(0, 0, 0), color(0, 0, 0), color(10, 
      0, 0), color(0, 0, 0), color(10, 0, 0)]
end

check "liquify-dynamic-programming same energy sensitivity":
  # all streams same energy
  liquify-dynamic-programming(image2, 1) is [image(1, 2): color(1, 0, 2), 
    color(0, 3, 0)]

  # same energy streams start different place end one place
  liquify-dynamic-programming(image3, 1)
    is [image(4, 3): color(0, 10, 0), color(0, 10, 0), color(0, 0, 0), 
    color(0, 10, 0), color(0, 100, 0), color(0, 10, 0), color(0, 10, 0), 
    color(0, 100, 0), color(0, 200, 0), color(0, 100, 0), color(0, 100, 0), 
    color(0, 200, 0)]

  # same energy streams start same end same diverge middle
  liquify-dynamic-programming(image4, 1)
    is [image(4, 3): color(0, 20, 0), color(0, 0, 0), color(0, 0, 0), color(0, 
      20, 0), color(0, 250, 0), color(0, 100, 0), color(0, 10, 0), color(0, 250,
      0), color(0, 200, 0), color(0, 100, 0), color(0, 100, 0), color(0, 200, 
      0)]

  # multiple seams all disjoint
  liquify-dynamic-programming(image5, 1)
    is [image(6, 3): color(0, 0, 0), color(10, 0, 0), color(0, 0, 0), 
    color(10, 0, 0), color(0, 0, 0), color(10, 0, 0), color(0, 0, 0), 
    color(10, 0, 0), color(0, 0, 0), color(10, 0, 0), color(0, 0, 0), 
    color(10, 0, 0), color(0, 0, 0), color(10, 0, 0), color(0, 0, 0), 
    color(10, 0, 0), color(0, 0, 0), color(10, 0, 0)]
end