From 79965c5e3f09f87e2d13cfba631cf8111a4bf36d Mon Sep 17 00:00:00 2001 From: Arthur Peters Date: Thu, 16 Feb 2017 18:12:56 -0600 Subject: [PATCH] Add examples/tests for mutually recursive lenient Orc objects. --- OrcExamples/objects/sudoku_solver.orc | 224 ++++++++++++++++++ .../classes/tying_the_knot.orc | 53 +++++ 2 files changed, 277 insertions(+) create mode 100644 OrcExamples/objects/sudoku_solver.orc create mode 100644 OrcTests/test_data/functional_valid/classes/tying_the_knot.orc diff --git a/OrcExamples/objects/sudoku_solver.orc b/OrcExamples/objects/sudoku_solver.orc new file mode 100644 index 000000000..b66500750 --- /dev/null +++ b/OrcExamples/objects/sudoku_solver.orc @@ -0,0 +1,224 @@ +-- A simple deterministic sudoku solver + +{- +Import utilities and setup wrappers +-} + +import class ConcurrentHashMap = "java.util.concurrent.ConcurrentHashMap" + +def Set() = ConcurrentHashMap.newKeySet() + +def seq(n) = + def h(i) if (i <: n) = i : h(i+1) + def h(_) = [] + h(0) + +-- An object which selects the last remaining value from a set of possibilities +class SelectLastValue { + val possibilities + + val remaining = + val s = Set() + each(possibilities) >x> s.add(x) >> stop ; + s + + val valueCell = Cell() + + val value = valueCell.read() + + def remove(x) = + remaining.remove(x) >r> + ( + if r && remaining.size() = 1 then + valueCell.write(remaining.iterator().next()) + else + signal + ) >> r + + def toString() = value.toString() +} +def SelectLastValue(p) = new SelectLastValue { val possibilities = p } + +-- A 2-d grid of values with an indexing operation and a method called to fill the cells +class Grid { + -- Compute the value of (x, y). + -- This may not block on get. However it may return an object that leniently blocks on get. + def compute(Integer, Integer) :: Top + + val n :: Integer + val m :: Integer + + val storage = + val a = Array(n * m) + map(lambda ((x, y)) = a(x + y*n) := compute(x, y), + collect({ upto(n) >x> upto(m) >y> (x, y) })) >> + a + + def get(x :: Integer, y :: Integer) = storage(x + y*n)? + + def toString() = + "[\n" + + foldl(lambda(acc, y) = + acc + foldl(lambda(acc, x) = + acc + get(x, y).toString() + ", ", "", seq(n)) + "\n", + "", seq(n)) + "]" +} + +{- +The solver represents unsolved cells as unbound futures on objects. Each +objects which represents a cell waits on the values of constraining cells +to reduce its own set of possibilities. +-} + +-- The size of the sudoku puzzle, must be a square number (4, 9, 16, ...) +val X = -1 + +{- +val sqrtN = 2 + +val puzzle = [ +1, X, 3, X, +X, X, 1, 2, +2, 3, X, 1, +X, 1, 2, X +] + +val solution = [ +1, 2, 3, 4, +3, 4, 1, 2, +2, 3, 4, 1, +4, 1, 2, 3 +] +-- -} + +val sqrtN = 3 + +-- {- +val puzzle = [ +X, X, X, 2, 6, X, 7, X, 1, +6, 8, X, X, 7, X, X, 9, X, +1, 9, X, X, X, 4, 5, X, X, +8, 2, X, 1, X, X, X, 4, X, +X, X, 4, 6, X, 2, 9, X, X, +X, 5, X, X, X, 3, X, 2, 8, +X, X, 9, 3, X, X, X, 7, 4, +X, 4, X, X, 5, X, X, 3, 6, +7, X, 3, X, 1, 8, X, X, X +] + +val solution = [ +4, 3, 5, 2, 6, 9, 7, 8, 1, +6, 8, 2, 5, 7, 1, 4, 9, 3, +1, 9, 7, 8, 3, 4, 5, 6, 2, +8, 2, 6, 1, 9, 5, 3, 4, 7, +3, 7, 4, 6, 8, 2, 9, 1, 5, +9, 5, 1, 7, 4, 3, 6, 2, 8, +5, 1, 9, 3, 2, 6, 8, 7, 4, +2, 4, 8, 9, 5, 7, 1, 3, 6, +7, 6, 3, 4, 1, 8, 2, 5, 9 +] +-- -} + +{- +val puzzle = [ +X, 2, X, X, X, X, X, X, X, +X, X, X, 6, X, X, X, X, 3, +X, 7, 4, X, 8, X, X, X, X, +X, X, X, X, X, 3, X, X, 2, +X, 8, X, X, 4, X, X, 1, X, +6, X, X, 5, X, X, X, X, X, +X, X, X, X, 1, X, 7, 8, X, +5, X, X, X, X, 9, X, X, X, +X, X, X, X, X, X, X, 4, X +] + +val solution = [ +4, 3, 5, 2, 6, 9, 7, 8, 1, +6, 8, 2, 5, 7, 1, 4, 9, 3, +1, 9, 7, 8, 3, 4, 5, 6, 2, +8, 2, 6, 1, 9, 5, 3, 4, 7, +3, 7, 4, 6, 8, 2, 9, 1, 5, +9, 5, 1, 7, 4, 3, 6, 2, 8, +5, 1, 9, 3, 2, 6, 8, 7, 4, +2, 4, 8, 9, 5, 7, 1, 3, 6, +7, 6, 3, 4, 1, 8, 2, 5, 9 +] +-- -} + +val N = sqrtN * sqrtN + +def allNumbers() = upto(N) >x> x +def allSqrtNumbers() = upto(sqrtN) >x> x + +class SudokuCell { + val value :: Integer + + val number = value + 1 + def toString() = number.toString() +} + +{- +This can only solve sudoku puzzles where every step in immediately forced by the +existing state. If that is not the case it will stall. When such a stall takes place +the class will go quiescent, so onIdle could be used to detect this case and apply +guessing or heuristics. +-} + +val solver = new Grid { + val n = N + val m = N + + val input = puzzle + + def getPuzzleCell(x, y) = + val v = index(input, x + y*N) + if v :> 0 then + Some(v - 1) + else + None() + + def makeUnknown(myX, myY) = new (SelectLastValue with SudokuCell) { + val possibilities = collect(allNumbers) + + val _ = {| + ( + allNumbers() >x> (x, myY) | + allNumbers() >y> (myX, y) | + allSqrtNumbers() >x> allSqrtNumbers() >y> ((myX / sqrtN) * sqrtN + x, (myY / sqrtN) * sqrtN + y)) + >(x,y)> + Iff(x = myX && y = myY) >> + remove(get(x, y).value) >true> + -- Println("Removing " + get(x, y).value + " from " + (myX, myY) + " because of " + (x, y) + " leaving " + remaining) >> + stop | + value + |} + + -- val _ = Println("Solved " + (myX, myY) + " with " + number) + } + def makeKnown(myX, myY, v) = new SudokuCell { + val value = v + } + + def compute(myX, myY) = + val v = getPuzzleCell(myX, myY) + v >Some(n)> makeKnown(myX, myY, n) | + v >None()> makeUnknown(myX, myY) +} + +Println(solver.toString()) >> stop + +{- +OUTPUT: +[ +4, 3, 5, 2, 6, 9, 7, 8, 1, +6, 8, 2, 5, 7, 1, 4, 9, 3, +1, 9, 7, 8, 3, 4, 5, 6, 2, +8, 2, 6, 1, 9, 5, 3, 4, 7, +3, 7, 4, 6, 8, 2, 9, 1, 5, +9, 5, 1, 7, 4, 3, 6, 2, 8, +5, 1, 9, 3, 2, 6, 8, 7, 4, +2, 4, 8, 9, 5, 7, 1, 3, 6, +7, 6, 3, 4, 1, 8, 2, 5, 9, +] +signal +-} diff --git a/OrcTests/test_data/functional_valid/classes/tying_the_knot.orc b/OrcTests/test_data/functional_valid/classes/tying_the_knot.orc new file mode 100644 index 000000000..74da9d369 --- /dev/null +++ b/OrcTests/test_data/functional_valid/classes/tying_the_knot.orc @@ -0,0 +1,53 @@ +-- Tying the knot using lenient objects +-- "Tying the knot" in the same sense as cyclical values in haskell + +class LList { + val head + val tail + + def toString() :: String +} + +class LCons extends LList { + def toString() :: String = head + " :L: " + tail.toString() +} +val LCons = new { + def apply(h, t :: LList) = new LCons { + val head = h + val tail = t + } + def unapply(v) = + (v.head, v.tail) ; stop +} + +val LNil = new LList { + val head = stop + val tail = stop + + def toString() :: String = "LNil" + + def unapply(v) = if v = this then signal else stop +} + + +-- TODO: Take cannot be a method on LList (like it should be) because it would require LList to be recursive with other defs and vals outside the class group +def take(LList, Integer) :: LList +def take(_, 0) = LNil +def take(LNil(), _) = LNil +def take(l, n) = LCons(l.head, take(l.tail, n-1)) + +val o = new { + val x = LCons(1, LCons(2, x)) +} + +Println(LCons(1, LCons(2, LNil)).toString()) >> +Println(take(LCons(1, LCons(2, LNil)), 1).toString()) >> +Println(take(o.x, 10).toString()) >> +stop + +{- +OUTPUT: +1 :L: 2 :L: LNil +1 :L: LNil +1 :L: 2 :L: 1 :L: 2 :L: 1 :L: 2 :L: 1 :L: 2 :L: 1 :L: 2 :L: LNil +-} \ No newline at end of file