diff --git a/data/scenarios/Challenges/Ranching/00-ORDER.txt b/data/scenarios/Challenges/Ranching/00-ORDER.txt index b21978192..95978ccd7 100644 --- a/data/scenarios/Challenges/Ranching/00-ORDER.txt +++ b/data/scenarios/Challenges/Ranching/00-ORDER.txt @@ -1,2 +1,3 @@ capture.yaml +powerset.yaml gated-paddock.yaml diff --git a/data/scenarios/Challenges/Ranching/_powerset/setup.sw b/data/scenarios/Challenges/Ranching/_powerset/setup.sw new file mode 100644 index 000000000..d9d712c23 --- /dev/null +++ b/data/scenarios/Challenges/Ranching/_powerset/setup.sw @@ -0,0 +1,257 @@ +def elif = \t. \then. \else. {if t then else} end +def else = \t. t end + +// modulus function (%) +def mod : int -> int -> int = \i. \m. + i - m * (i / m) +end + +def doN = \n. \f. if (n > 0) {f; doN (n - 1) f} {}; end; + +def until = \p. \c. q <- p; if q {} {c; until p c} end; +def while = \p. until (x <- p; return $ not x) end; + +def isDivisibleBy = \dividend. \divisor. + (dividend / divisor) * divisor == dividend; + end; + +def isEven = \x. + isDivisibleBy x 2 + end; + +/** +Performs a right bitshift of "x" by "n" places +*/ +def shiftRight = \x. \n. + x / (2^n); + end; + +/** +Performs a left bitshift of "x" by "n" places +*/ +def shiftLeft = \x. \n. + x * (2^n); + end; + +/** +Checks whether the bit at index "idx" is set in the "bitmask". +zero-based indexing; 0 is the LSB. +*/ +def isBitSet = \bitmask. \idx. + not $ isEven $ shiftRight bitmask idx; + end; + +/** +Tests whether only a single bit is set in the bitmask. +Aborts early with 'false' if a second bit is detected. +*/ +def exactlyOneBit = \foundOneBit. \bitmask. + if (bitmask == 0) { + foundOneBit; + } { + let bitIsSet = not $ isEven bitmask in + if (foundOneBit && bitIsSet) { + false; + } { + exactlyOneBit (foundOneBit || bitIsSet) $ bitmask / 2; + } + } + end; + +/** Teleports to a new location to execute a function + then returns to the original location before + returning the functions output value. +*/ +def atLocation = \newLoc. \f. + prevLoc <- whereami; + teleport self newLoc; + retval <- f; + teleport self prevLoc; + return retval; + end; + +def placeSand = + let item = "sand" in + create item; + place item; + move; + end; + +/** +Repeatedly generate a random number until +we find one that's not in the bitmask. +*/ +def getUnusedRandom = \maxval. \bitmask. + nextRandomVal <- random maxval; + if (isBitSet bitmask nextRandomVal) { + getUnusedRandom maxval bitmask; + } { + return nextRandomVal; + } + end; + +def getEntName = \idx. + if (idx == 1) { + "grape" + } $ elif (idx == 2) { + "lemon" + } $ elif (idx == 3) { + "apple" + } $ elif (idx == 4) { + "blueberry" + } $ elif (idx == 5) { + "watermelon" + } $ elif (idx == 6) { + "orange" + } $ else { + "dragonfruit" + } + end; + +def getMissingBitRecursive = \bitmask. \idx. + if (idx > 0) { + if (isEven bitmask) { + idx + } { + getMissingBitRecursive (bitmask / 2) $ idx - 1; + } + } { + // The MSB was the missing bit. + 0; + } + end; + +/** +Returns the index of the right-most bit that is zero. +*/ +def getMissingBit = \bitmask. \maxIdx. + let val = getMissingBitRecursive bitmask maxIdx in + maxIdx - val; + end; + +/** +Use the `random` function to generate a random permuation of `n` contiguous values. +Uses a bitmask to ensure uniqueness. + +Fisher-Yates would be more efficient, but requires a physical array. +*/ +def naiveRandomStack = \valueFunc. \maxval. \bitmask. \n. + val <- if (n > 1) { + nextRandomVal <- getUnusedRandom maxval bitmask; + + // Recursion bug workaround (see #1032): + let blahNextRandomVal = nextRandomVal in + + let newBitmask = bitmask + shiftLeft 1 nextRandomVal in + naiveRandomStack valueFunc maxval newBitmask $ n - 1; + return blahNextRandomVal; + } { + // We're at the peak of the stack. + // Now we unwind it. + + // Saves some time in generating the last number by inferring the + // only remaining possible choice. + let missingBit = getMissingBit bitmask maxval in + return missingBit; + }; + valueFunc val; + end; + +def placeThing = \entIdx. + let entName = getEntName entIdx in + create entName; + place entName; + end; + +def placeEntsForBits = \bitmask. \bitIndex. + if (isBitSet bitmask bitIndex) { + placeThing bitIndex; + move; + } {}; + end; + +def columnFunc = \exclusionValue. \inputCardinality. \x. + if (x != 0 && x != exclusionValue && not (exactlyOneBit false x)) { + naiveRandomStack (placeEntsForBits x) inputCardinality 0 inputCardinality; + myloc <- whereami; + teleport self (fst myloc + 1, 0); + } {}; + end; + +def makeSandRow = \length. + turn east; + atLocation (0, -1) $ doN length placeSand; + end; + +def chooseExclusionValue = \powersetCardinality. + + // For cardinality 32, for example, the value of "r" + // will be between 0 and 30, inclusive. + r <- random $ powersetCardinality - 1; + + // We offset by one so as not to exclude zero. + // So the exclusion value is now between + // 1 and 31, inclusive. + let value = r + 1 in + + if (exactlyOneBit false value) { + chooseExclusionValue powersetCardinality; + } { + return value; + } + end; + +/** +"inputCardinality" is the number of distinct entities +*/ +def setup = \inputCardinality. + let powersetCardinality = 2^inputCardinality in + makeSandRow $ powersetCardinality - (1 + inputCardinality); + + turn north; + move; + exclusionValue <- chooseExclusionValue powersetCardinality; + naiveRandomStack (columnFunc exclusionValue inputCardinality) powersetCardinality 0 powersetCardinality; + return exclusionValue; + end; + +/** +One-based ordinal of the item. +*/ +def getOrdinal : text -> cmd int = \item. + count item; + end; + +def checkSolutionSum = \runningSum. + maybeItem <- scan down; + case maybeItem (\_. return runningSum) (\item. + // The bell is the only other item we can place in this + // scenario besides the fruits. + if (item != "bell") { + theOrdinal <- getOrdinal item; + let binaryValue = shiftLeft 1 $ theOrdinal - 1 in + move; + checkSolutionSum $ binaryValue + runningSum; + } {return runningSum}; + ); + end; + +def waitForFirstPlacement = + watch down; + wait 1000; + emptyhere <- isempty; + if emptyhere {waitForFirstPlacement} {}; + end; + +def go = \distinctCount. + exclusionValue <- instant $ setup distinctCount; + give base "bell"; + + waitForFirstPlacement; + while (as base {has "bell"}) $ wait 2; + theSum <- checkSolutionSum 0; + let sentinelItem = if (exclusionValue == theSum) {"bit (1)"} {"bit (0)"} in + create sentinelItem; + end; + +go 7; \ No newline at end of file diff --git a/data/scenarios/Challenges/Ranching/_powerset/solution.sw b/data/scenarios/Challenges/Ranching/_powerset/solution.sw new file mode 100644 index 000000000..8198101fe --- /dev/null +++ b/data/scenarios/Challenges/Ranching/_powerset/solution.sw @@ -0,0 +1,168 @@ +def doN = \n. \f. if (n > 0) {f; doN (n - 1) f} {}; end; +def until = \p. \c. q <- p; if q {} {c; until p c} end; +def while = \p. until (x <- p; return $ not x) end; + +def abs = \n. if (n < 0) {-n} {n} end; + +def intersperse = \n. \f2. \f1. + if (n > 0) { + f1; + if (n > 1) { + f2; + } {}; + intersperse (n - 1) f2 f1; + } {}; + end; + +def mapTuple = \f. \t. + (f $ fst t, f $ snd t) + end; + +def sumTuples = \t1. \t2. + (fst t1 + fst t2, snd t1 + snd t2); + end; + +def negateTuple = \t. + mapTuple (\x. -x) t; + end; + +def getRelativeLocation = \absCurrentLoc. \absDestLoc. + let negatedLoc = negateTuple absCurrentLoc in + return $ sumTuples negatedLoc absDestLoc; + end; + +def splitStride = \n. + let dist = abs n in + if (dist > 64) { + stride 64; + splitStride $ dist - 64; + } { + stride dist; + } + end; + +def moveTuple = \tup. + let x = fst tup in + let y = snd tup in + turn $ if (x > 0) {east} {west}; + // doN (abs x) move; + splitStride x; + + turn $ if (y > 0) {north} {south}; + // doN (abs y) move; + splitStride y; + end; + +def goToLocation = \currentLoc. \absoluteDestination. + relativeDestination <- getRelativeLocation currentLoc absoluteDestination; + moveTuple relativeDestination; + end; + +def recordFirstEncounter = \stashLoc. \item. + originalHeading <- heading; + originalLoc <- whereami; + goToLocation originalLoc stashLoc; + turn south; + until isempty move; + place item; + + newCurrentLoc <- whereami; + goToLocation newCurrentLoc originalLoc; + turn originalHeading; + end; + +def tryHarvest = \stashLoc. + maybeItem <- scan down; + case maybeItem return (\item. + hasSome <- has item; + harvest; + if hasSome {} { + while isempty $ wait 1; + // Grab another one so that our "sentinel condition" won't + // be invalidated when we go on to place it + harvest; + recordFirstEncounter stashLoc item; + }; + ); + end; + +def doRow = \stashLoc. \sandLength. + intersperse (sandLength - 1) move $ tryHarvest stashLoc; + end; + +def turnaround = \d. + turn d; + move; + turn d; + end; + +/** +Precondition: +At the start of the line, facing along the line. +*/ +def countLine = \tally. + emptyhere <- isempty; + if emptyhere { + turn back; + splitStride tally; + return tally; + } { + move; + countLine $ tally + 1; + } + end; + +def placeFinalCopy = \item. + originalLoc <- whereami; + goToLocation originalLoc (fst originalLoc, 0); + until isempty move; + place item; + newLoc <- whereami; + goToLocation newLoc originalLoc; + end; + +def copyIfNeeded = \targetCount. + maybeItem <- scan down; + case maybeItem return (\item. + quantity <- count item; + if (quantity < targetCount) { + placeFinalCopy item; + } {}; + ); + move; + end; + +def harvestForCounts = \rowLength. \stashLoc. \sweepCount. + + intersperse sweepCount (turnaround right) $ + intersperse 2 (turnaround left) $ doRow stashLoc rowLength; + + turnaround right; + doRow stashLoc rowLength; + end; + +def go = \sweepCount. + until (has "bell") $ wait 2; + + move; + rowLength <- countLine 0; + let stashLoc = (rowLength - 1, -2) in + turnaround right; + + harvestForCounts rowLength stashLoc sweepCount; + + originalLoc <- whereami; + goToLocation originalLoc stashLoc; + turn south; + + entityCardinality <- countLine 0; + + turn back; + let expectedCount = 2^(entityCardinality - 1) - 1 in + doN entityCardinality $ copyIfNeeded expectedCount; + + // Mark goal-checkability sentinel + place "bell"; + end; + +go 3; \ No newline at end of file diff --git a/data/scenarios/Challenges/Ranching/powerset.yaml b/data/scenarios/Challenges/Ranching/powerset.yaml new file mode 100644 index 000000000..77563fbcb --- /dev/null +++ b/data/scenarios/Challenges/Ranching/powerset.yaml @@ -0,0 +1,190 @@ +version: 1 +name: Fruit hybrids +author: Karl Ostmo +description: | + Find the missing fruit combination +creative: false +attrs: + - name: fruit0 + fg: "#ff0080" + - name: fruit1 + fg: "#b000ff" + - name: fruit2 + fg: "#ffff00" + - name: fruit3 + fg: "#ff0000" + - name: fruit4 + fg: "#0000ff" + - name: fruit5 + fg: "#00ff00" + - name: fruit6 + fg: "#ff8000" +objectives: + - teaser: Find missing hybrid + id: complete_powerset + goal: + - | + Farmer Bill is breeding hybrid fruits. + Each fruit can be paired with one or more other fruit variety, and Bill + wants to evaluate every such combination. + He has arranged each hybrid in a column in his orchard. + - | + However, his experiment is incomplete! He has forgotten one combination. + - | + Place the missing hybrid combination in the empty eastern-most column. + After you have done this, `place` the "bell" anywhere, and then Bill will inspect + your work. + prerequisite: + not: wrong_anwser + condition: | + r <- robotnamed "setup"; + as r {has "bit (1)"}; + - teaser: Wrong answer + id: wrong_anwser + optional: true + goal: + - | + Farmer Bill is disappointed. + condition: | + r <- robotnamed "setup"; + as r {has "bit (0)"}; +robots: + - name: base + dir: [1, 0] + devices: + - ADT calculator + - branch predictor + - hourglass + - comparator + - compass + - counter + - dictionary + - Elmer's glue + - fruit picker + - fruit planter + - GPS receiver + - lambda + - linotype + - lodestone + - logger + - keyboard + - net + - rocket skates + - scanner + - strange loop + - treads + - name: setup + system: true + dir: [1, 0] + display: + invisible: true + inventory: + - [1, bell] + - [1, dragonfruit] + - [2, grape] + - [3, lemon] + - [4, apple] + - [5, blueberry] + - [6, watermelon] + - [7, orange] + program: | + run "scenarios/Challenges/Ranching/_powerset/setup.sw" +solution: | + run "scenarios/Challenges/Ranching/_powerset/solution.sw" +entities: + - name: rocket skates + display: + attr: silver + char: 's' + description: + - Allows one to `stride` across multiple cells + properties: [known, portable] + capabilities: [movemultiple] + - name: bell + display: + char: 'B' + attr: gold + description: + - A bell for Bill + properties: [known, portable] + - name: fruit picker + display: + char: 'P' + description: + - Enables the `harvest` command. + properties: [known] + capabilities: [harvest] + - name: fruit planter + display: + char: 'p' + description: + - Enables the `place` command. + properties: [known] + capabilities: [place] + - name: dragonfruit + display: + char: 'Y' + attr: fruit0 + description: + - Dragonfruits + properties: [known, growable, portable] + growth: [10, 10] + - name: grape + display: + char: 'Y' + attr: fruit1 + description: + - Grapes + growth: [10, 10] + properties: [known, growable, portable] + - name: lemon + display: + char: 'Y' + attr: fruit2 + description: + - Lemons + growth: [10, 10] + properties: [known, growable, portable] + - name: apple + display: + char: 'Y' + attr: fruit3 + description: + - Apple + growth: [10, 10] + properties: [known, growable, portable] + - name: blueberry + display: + char: 'Y' + attr: fruit4 + description: + - Blueberries + growth: [10, 10] + properties: [known, growable, portable] + - name: watermelon + display: + char: 'Y' + attr: fruit5 + description: + - Watermelons + growth: [10, 10] + properties: [known, growable, portable] + - name: orange + display: + char: 'Y' + attr: fruit6 + description: + - Oranges + growth: [10, 10] + properties: [known, growable, portable] +known: [sand] +world: + default: [grass] + upperleft: [-1, -1] + offset: false + palette: + '.': [grass] + 'B': [grass, null, base] + 'S': [grass, null, setup] + map: | + BS diff --git a/test/integration/Main.hs b/test/integration/Main.hs index 0b53abb6b..a5d659d33 100644 --- a/test/integration/Main.hs +++ b/test/integration/Main.hs @@ -211,6 +211,7 @@ testScenarioSolution _ci _em = , testGroup "Ranching" [ testSolution Default "Challenges/Ranching/capture" + , testSolution (Sec 5) "Challenges/Ranching/powerset" , testSolution (Sec 30) "Challenges/Ranching/gated-paddock" ] , testGroup