urbit/developers.urbit.org
1
1
Fork 0
mirror of https://github.com/urbit/developers.urbit.org.git synced 2024-08-16 17:20:35 +03:00
Code Issues Packages Projects Releases Wiki Activity

added hsl-23-1 coding challenges to hoon wb

Browse Source
This commit is contained in:
jack-z-wang 2023-06-27 13:37:55 -04:00
parent d9496f1f65
commit e118605a6f
3 changed files with 1529 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

574
content/guides/additional/workbook/abc-blocks.md Normal file
View File

@ -0,0 +1,574 @@
+++
title = "ABC Blocks"
weight = 48
+++
## Challenge: ABC Blocks
You are given a collection of blocks with two letters of the alphabet on each block. A complete alphabet is guaranteed among all sides of the blocks. You would like to check if a given word can be written with the provided set of blocks.
An example set of blocks:
```
(F E)
(A W)
(Q V)
(B M)
(X H)
(N P)
(I Z)
(G U)
(S R)
(K Y)
(T L)
(O C)
(J D)
(A N)
(O B)
(E R)
(F S)
(L Y)
(P C)
(Z M)
```
Your task for this challenge is to write a generator `abc-blocks`. It takes a cell of two arguments. The first argument is a `(list (pair @t @t))` which represents the input set of blocks. The second argument is a `@t` which represents the word that you'd like to check.
Your generator should first check if the input blocks cover all letters of the alphabet. If not, the generator should fail (possibly returning an error message). It should also check if the input word only has alphabetical characters (no spaces, numbers, or special characters). Otherwise it should fail. Then, it should check whether the word can be spelled with the blocks, either returning a `%.y` or `%.n`. It should not care about case, for the blocks or for the word.
Example usage:
```
> +abc-blocks [[['a', 'b'] ['c' 'd'] ['e' 'f'] ~] 'fad']
dojo: naked generator failure
> +abc-blocks [[['a', 'b'] ['c' 'd'] ['e' 'f'] ['g' 'h'] ['i' 'j'] ['k' 'l'] ['m' 'n'] ['o' 'p'] ['q' 'r'] ['s' 't'] ['u 'v'] ['w' 'x] ['y' z] ~] '12%-3']
dojo: naked generator failure
> +abc-blocks [[['a', 'B'] ['C' 'd'] ['e' 'F'] ['G' 'h'] ['i' 'J'] ['K' 'l'] ['m' 'N'] ['o' 'P'] ['Q' 'r'] ['s' 'T'] ['U 'v'] ['w' 'X'] ['y' Z'] ~] 'cat']
%.y
> +abc-blocks [[['a', 'B'] ['C' 'd'] ['e' 'F'] ['G' 'h'] ['i' 'J'] ['K' 'l'] ['m' 'N'] ['o' 'P'] ['Q' 'r'] ['s' 'T'] ['U 'v'] ['w' 'X'] ['y' Z'] ~] 'CAT']
%.y
> +abc-blocks [[['a', 'B'] ['C' 'd'] ['e' 'F'] ['G' 'h'] ['i' 'J'] ['K' 'l'] ['m' 'N'] ['o' 'P'] ['Q' 'r'] ['s' 'T'] ['U 'v'] ['w' 'X'] ['y' Z'] ~] 'BAT']
%.n
```
## Unit Tests
Following a principle of test-driven development, we compose a series of tests which allow us to rigorously check for expected behavior.
```
/+ *test
/= abc-blocks /gen/abc-blocks
|%
:: test for failure of incomplete alphabet
::
++ test-01
=/ blocks `(list (pair @t @t))`[['a' 'b'] ['c' 'd'] ['e' 'f'] ['g' 'h'] ['i' 'j'] ['k' 'l'] ['m' 'n'] ['o' 'p'] ['q' 'q'] ['s' 't'] ['u' 'v'] ['w' 'x'] ['y' 'z'] ~]
=/ word `@t`'foo'
%- expect-fail |. (abc-blocks blocks word)
++ test-02
=/ blocks `(list (pair @t @t))`[['a' 'b'] ['c' 'd'] ['e' 'f'] ['g' 'h'] ['i' 'j'] ['k' 'l'] ['m' 'n'] ['q' 'r'] ['s' 't'] ['u' 'v'] ['w' 'x'] ['y' 'z'] ~]
=/ word `@t`'foo'
%- expect-fail |. (abc-blocks blocks word)
++ test-03
=/ blocks `(list (pair @t @t))`[['A' 'B'] ['C' 'D'] ['E' 'F'] ['G' 'H'] ['I' 'J'] ['K' 'L'] ['M' 'N'] ['O' 'P'] ['Q' 'R'] ['S' 'A'] ['U' 'V'] ['W' 'X'] ['Y' 'Z'] ~]
=/ word `@t`'foo'
%- expect-fail |. (abc-blocks blocks word)
++ test-04
=/ blocks `(list (pair @t @t))`[['A' 'B'] ['C' 'D'] ['e' 'f'] ['G' 'H'] ['I' 'J'] ['K' 'L'] ['M' 'N'] ['O' 'P'] ['Q' 'R'] ['S' 'A'] ['U' 'V'] ['W' 'X'] ['Y' 'Z'] ['A' 'B'] ['j' 'x']~]
=/ word `@t`'foo'
%- expect-fail |. (abc-blocks blocks word)
++ test-05
=/ blocks `(list (pair @t @t))`[['F' 'M'] ['W' 'S'] ['I' 'B'] ['Q' 'K'] ['Z' 'H'] ['G' 'L'] ['U' 'J'] ['V' 'A'] ['C' 'T'] ['R' 'O'] ['P' 'N'] ['E' 'Y'] ~]
=/ word `@t`'foo'
%- expect-fail |. (abc-blocks blocks word)
:: test for failure of input word
::
++ test-06
=/ blocks `(list (pair @t @t))`[['F' 'M'] ['W' 'S'] ['I' 'B'] ['D' 'X'] ['Q' 'K'] ['Z' 'H'] ['G' 'L'] ['U' 'J'] ['V' 'A'] ['C' 'T'] ['R' 'O'] ['P' 'N'] ['E' 'Y'] ~]
=/ word `@t`'foo bar'
%- expect-fail |. (abc-blocks blocks word)
++ test-07
=/ blocks `(list (pair @t @t))`[['F' 'M'] ['W' 'S'] ['I' 'B'] ['D' 'X'] ['Q' 'K'] ['Z' 'H'] ['G' 'L'] ['U' 'J'] ['V' 'A'] ['C' 'T'] ['R' 'O'] ['P' 'N'] ['E' 'Y'] ~]
=/ word `@t`'foo1bar'
%- expect-fail |. (abc-blocks blocks word)
++ test-08
=/ blocks `(list (pair @t @t))`[['F' 'M'] ['W' 'S'] ['I' 'B'] ['D' 'X'] ['Q' 'K'] ['Z' 'H'] ['G' 'L'] ['U' 'J'] ['V' 'A'] ['C' 'T'] ['R' 'O'] ['P' 'N'] ['E' 'Y'] ~]
=/ word `@t`'foo!bar'
%- expect-fail |. (abc-blocks blocks word)
:: test for success with various capitalizations and alphabets
::
++ test-09
=/ blocks `(list (pair @t @t))`[['F' 'M'] ['W' 'S'] ['I' 'B'] ['D' 'X'] ['Q' 'K'] ['Z' 'H'] ['G' 'L'] ['U' 'J'] ['V' 'A'] ['C' 'T'] ['R' 'O'] ['P' 'N'] ['E' 'Y'] ~]
=/ word `@t`'TRAP'
%+ expect-eq
!> %.y
!> (abc-blocks blocks word)
++ test-10
=/ blocks `(list (pair @t @t))`[['F' 'M'] ['W' 'S'] ['I' 'B'] ['D' 'X'] ['Q' 'K'] ['Z' 'H'] ['G' 'L'] ['U' 'J'] ['V' 'A'] ['C' 'T'] ['R' 'O'] ['P' 'N'] ['E' 'Y'] ~]
=/ word `@t`'trap'
%+ expect-eq
!> %.y
!> (abc-blocks blocks word)
++ test-11
=/ blocks `(list (pair @t @t))`[['F' 'M'] ['W' 'S'] ['I' 'B'] ['D' 'X'] ['Q' 'K'] ['Z' 'H'] ['G' 'L'] ['U' 'J'] ['V' 'A'] ['C' 'T'] ['R' 'O'] ['P' 'N'] ['E' 'Y'] ~]
=/ word `@t`'tRaP'
%+ expect-eq
!> %.y
!> (abc-blocks blocks word)
++ test-12
=/ blocks `(list (pair @t @t))`[['f' 'm'] ['w' 's'] ['i' 'b'] ['d' 'x'] ['q' 'k'] ['z' 'h'] ['g' 'l'] ['u' 'j'] ['v' 'a'] ['c' 't'] ['r' 'o'] ['p' 'n'] ['e' 'y'] ~]
=/ word `@t`'TRAP'
%+ expect-eq
!> %.y
!> (abc-blocks blocks word)
++ test-13
=/ blocks `(list (pair @t @t))`[['f' 'm'] ['w' 's'] ['i' 'b'] ['d' 'x'] ['q' 'k'] ['z' 'h'] ['g' 'l'] ['u' 'j'] ['v' 'A'] ['c' 't'] ['R' 'o'] ['p' 'n'] ['e' 'y'] ~]
=/ word `@t`'trap'
%+ expect-eq
!> %.y
!> (abc-blocks blocks word)
++ test-14
=/ blocks `(list (pair @t @t))`[['f' 'm'] ['w' 's'] ['i' 'b'] ['d' 'x'] ['q' 'k'] ['z' 'h'] ['g' 'l'] ['u' 'j'] ['v' 'A'] ['c' 't'] ['R' 'o'] ['p' 'n'] ['e' 'y'] ['x' 'y'] ['a' 'b'] ~]
=/ word `@t`'fsixqhgjvtrnyyb'
%+ expect-eq
!> %.y
!> (abc-blocks blocks word)
:: test for being unable to make a word
::
++ test-15
=/ blocks `(list (pair @t @t))`[['f' 'm'] ['w' 's'] ['i' 'b'] ['d' 'x'] ['q' 'k'] ['z' 'h'] ['g' 'l'] ['u' 'j'] ['v' 'A'] ['c' 't'] ['R' 'o'] ['p' 'n'] ['e' 'y'] ['x' 'y'] ['a' 'b'] ~]
=/ word `@t`'fsixqhgjvtrnyyyb'
%+ expect-eq
!> %.n
!> (abc-blocks blocks word)
++ test-16
=/ blocks `(list (pair @t @t))`[['f' 'm'] ['w' 's'] ['i' 'b'] ['d' 'x'] ['q' 'k'] ['z' 'h'] ['g' 'l'] ['u' 'j'] ['v' 'A'] ['c' 't'] ['R' 'o'] ['p' 'n'] ['e' 'y'] ['x' 'y'] ['a' 'b'] ~]
=/ word `@t`'fsixqhgujvtrnyyb'
%+ expect-eq
!> %.n
!> (abc-blocks blocks word)
++ test-17
=/ blocks `(list (pair @t @t))`[['f' 'm'] ['w' 's'] ['i' 'b'] ['d' 'x'] ['q' 'k'] ['z' 'h'] ['g' 'l'] ['u' 'j'] ['v' 'A'] ['c' 't'] ['R' 'o'] ['p' 'n'] ['e' 'y'] ['x' 'y'] ['a' 'b'] ~]
=/ word `@t`'AAA'
%+ expect-eq
!> %.n
!> (abc-blocks blocks word)
++ test-18
=/ blocks `(list (pair @t @t))`[['A' 'B'] ['C' 'D'] ['E' 'F'] ['G' 'H'] ['I' 'J'] ['K' 'L'] ['M' 'N'] ['O' 'P'] ['Q' 'R'] ['S' 'T'] ['U' 'V'] ['W' 'X'] ['Y' 'Z'] ~]
=/ word `@t`'AGENTT'
%+ expect-eq
!> %.n
!> (abc-blocks blocks word)
++ test-19
=/ blocks `(list (pair @t @t))`[['A' 'B'] ['C' 'D'] ['E' 'F'] ['G' 'H'] ['I' 'J'] ['K' 'L'] ['M' 'N'] ['O' 'P'] ['Q' 'R'] ['S' 'T'] ['U' 'V'] ['W' 'X'] ['Y' 'Z'] ['S' 'T'] ~]
=/ word `@t`'AGENTtT'
%+ expect-eq
!> %.n
!> (abc-blocks blocks word)
++ test-20
=/ blocks `(list (pair @t @t))`[['A' 'Z'] ['A' 'Z'] ['F' 'M'] ['W' 'S'] ['I' 'B'] ['D' 'X'] ['Q' 'K'] ['Z' 'H'] ['G' 'L'] ['U' 'J'] ['V' 'A'] ['C' 'T'] ['R' 'O'] ['P' 'N'] ['E' 'Y'] ~]
=/ word `@t`'ZAZAZ'
%+ expect-eq
!> %.n
!> (abc-blocks blocks word)
--
```
## Solutions
_These solutions were submitted by the Urbit community as part of a competition in ~2023.6. They are made available under the GNU License. We ask you to acknowledge authorship should you utilize these elsewhere._
### Solution #1
_By ~dozreg-toplud. In the process, he found and fixed a bug in the implementation of ++curr._
```
:: +abc-blocks: a solution to the HSL challenge #2
::
:: https://github.com/tamlut-modnys/template-hsl-abc-blocks
:: Takes a cell of arguments [blocks=(list (pair @t @t)) word=@t],
:: produces a flag.
:: Crashes if the alphabet is not represented in the blocks, or if there are
:: non-alphabetical characters in the blocks or in the word.
:: Produces %.y if the word can be written with the given list of blocks,
:: %.n otherwise
::
:: Solving this challenge revealed a bug in ++curr implementation! Refer to
:: the bottom of the file.
::
|^
:: Main part:
::
|= [blocks=(list (pair @t @t)) word=@t]
^- ?
=/ word-tape=tape (trip word)
:: Convert input values to lowercase
::
=. word-tape (cass word-tape)
=. blocks
%+ turn
blocks
|= [a=@t b=@t]
^- (pair @t @t)
:- (crip (cass (trip a)))
(crip (cass (trip b)))
:: Define alphabet
::
=/ alphabet=(set @t) (silt "abcdefghijklmnopqrstuvwxyz")
:: Assert: only alphabetical characters in the blocks
::
?. %+ levy
blocks
|= [a=@t b=@t]
^- ?
&((~(has in alphabet) a) (~(has in alphabet) b))
~_ leaf+"non-alphabetical character in blocks"
!!
:: Assert: only alphabetical characters in the word
::
?. %+ levy
word-tape
|= =cord
^- ?
(~(has in alphabet) cord)
~_ leaf+"non-alphabetical character in word"
!!
:: Assert: complete alphabet among the blocks
::
?. :: Iterate for block list indices i:
::
=+ i=0
|- ^- ?
:: if the alphabet set is empty, then the blocks contain all the letters
::
?: =(~ alphabet)
%.y
:: else, if we reached the end of the block list, then the opposite is true
::
?: =(i (lent blocks))
%.n
:: else, delete letters on a block from the alphabet and continue
::
=+ [a b]=(snag i blocks)
$(i +(i), alphabet (~(del in (~(del in alphabet) b)) a))
~_ leaf+"not complete alphabet in blocks"
!!
:: check if we can compose the word with the blocks
::
(check blocks word-tape)
::
:: Helping functions
:: ++check: checks if the word can be composed with the given blocks
::
++ check
|= [blocks=(list (pair @t @t)) word=tape]
^- ?
:: Self-reference
::
=* this-gate ..$
:: The word can be composed if it's empty, ...
::
?~ word %.y
:: ... or if the list of indices of blocks that contain i.word is not empty
:: and t.word can be composed with at least one list of the blocks made by
:: removing one of the blocks that contain i.word.
::
:: Logical OR on a list (%.n if the list is empty)
::
%+ lien
:: (list of lists of blocks made by removing one block that contains
:: i.word for each such block)
::
%+ turn
:: (list of block indices that contain i.word)
::
(find-in-blocks i.word blocks)
:: (gate that removes a block from a list of blocks by an index)
::
(curr (curr oust blocks) 1)
:: (gate that applies ++check to a given list of blocks and t.word)
::
(curr this-gate t.word)
:: ++ find-in-blocks: returns a list of block indices that contain
:: a given letter
::
++ find-in-blocks
|= [letter=@t blocks=(list (pair @t @t))]
^- (list @)
=+ i=0
=| =(list @)
:: Iterate over elements of blocks
::
|-
?~ blocks
list
:: If a block contains the letter, append its index to the list
::
=? list |(=(letter -:i.blocks) =(letter +:i.blocks)) (snoc list i)
$(i +(i), blocks t.blocks)
:: ++curr: rewrite ++curr from stdlib because the original has a bug
:: (https://github.com/urbit/urbit/issues/6655)
::
++ curr
|* [a=$-(^ *) c=*]
|* b=_,.+<-.a
(a b c)
::
--
```
### Solution #2
_By ~bantus-follus_
```
|= [blocks=(list (pair @t @t)) word=@t]
=<
=/ alphacheck (alphabet-check merged-blocks)
?. (character-check word)
~| "Input word contains invalid characters." !!
=/ spellcheck (spell-check word)
spellcheck
|%
++ alphabet "abcdefghijklmnopqrstuvwxyz"
::
:: merges all blocks into a single tape
++ merged-blocks (merge blocks)
::
:: turns all blocks into individual tapes
++ tape-blocks (turn (turn (turn (turn blocks pair-to-list) crip) trip) cass)
++ merge
|= blocks=(list (pair @t @t))
^- tape
(cass (trip (crip `(list @t)`(zing (turn blocks pair-to-list)))))
::
:: converts each pair to a (list @t)
++ pair-to-list
|= input=(pair @t @t)
^- (list @t)
[-:input +:input ~]
::
:: checks if input blocks cover all letters of the alphabet
++ alphabet-check
|= input=tape
^- ?
=/ i 0
|-
?: =(i 26)
%.y
?~ (find [(snag i alphabet)]~ input)
~| "Full alphabet not found. {<(snag i alphabet)>} not in blocks" !!
$(i +(i))
::
:: checks if input word has valid chaaracters. %.y means all characters are valid
++ character-check
|= word=@t
^- ?
=/ i 0
=/ tapeword (cass (trip word))
|-
?: =(+(i) (lent tapeword))
%.y
?~ (find [(snag i tapeword)]~ alphabet)
%.n
$(i +(i))
::
:: checks if the word can be spelled using the input blocks
++ spell-check
|= word=@t
^- ?
=/ tapeword (cass (trip word))
=/ tape-blocks tape-blocks
=/ i 0
=/ letter (snag i tapeword)
|-
?: =(+(i) (lent tapeword))
=/ blockcheck (check-blocks [tape-blocks letter])
?. check:blockcheck
%.n
%.y
=/ blockcheck (check-blocks [tape-blocks letter])
?. check:blockcheck
%.n
$(i +(i), letter (snag +(i) tapeword), tape-blocks (oust [num:blockcheck 1] tape-blocks))
:: cycles through blocks, checking for a letter
++ check-blocks
|= [tape-blocks=(list tape) letter=@t]
^- [num=@ check=?]
=/ i 0
=/ block (snag i tape-blocks)
|-
?: =(+(i) (lent tape-blocks))
?~ (find [letter]~ block)
[~ %.n]
[i %.y]
?~ (find [letter]~ block)
$(i +(i), block (snag +(i) tape-blocks))
[i %.y]
--
```
### Solution #3
_By ~dannul-bortux_
```
!:
|= [inlist=(list [@t @t]) inword=@t]
^- $?(%.y %.n)
:: If, input list is empty
::
?: =(0 (lent inlist))
:: Then, throw error
::
~| 'Error - input list cannot be empty'
!!
=< (validate-input inlist (cass (trip inword)))
|%
++ validate-input
|= [blocks=(list [@t @t]) cword=tape]
=/ lblocks (to-lowercase blocks)
?: ?& (validate-alpha-only cword)
(validate-complete-alpha lblocks)
(validate-word lblocks cword)
==
%.y
%.n
++ validate-alpha-only
|= w=tape
=/ i 0
:: =/ tword (trip w)
|-
?: =(i (lent w))
%.y
?. ?& (gte `@ud`(snag i w) 97)
(lte `@ud`(snag i w) 122)
==
!!
%= $
i +(i)
==
++ validate-complete-alpha
|= blocks=(list [@t @t])
=/ alphabet "abcdefghijklmnopqrstuvwxyz"
=/ bltape (block-taper blocks)
:: ~& "bl tape is {<bltape>}"
:: =/ bltape "abcdefghijklmnopqrstuvwxyz"
=/ i 0
|-
?: =(i (lent alphabet))
:: ~& "returning yes"
%.y
?: =(~ (find (trip (snag i alphabet)) bltape))
:: ~& "returning no at letter: {<(snag i alphabet)>}"
!!
%= $
:: alphabet (remove-letters alphabet (snag i blocks))
i +(i)
==
:: %.n
:: ++ remove-letters
:: |= [in=tape let=[@t @t]]
:: ~& "removing letters"
:: in
++ block-taper
|= b=(list [@t @t])
=/ i 0
=/ bltape *tape
|-
?: =(i (lent b))
bltape
:: ~& +2:(snag i `(list [@t @t])`b)
%= $
bltape (snoc (snoc bltape +2:(snag i `(list [@t @t])`b)) +3:(snag i `(list [@t @t])`b))
:: bltape (snoc bltape 'a')
i +(i)
==
++ validate-word
|= [blocks=(list [@t @t]) cword=tape]
=/ wordcombos `(list tape)`(get-combos blocks)
:: ~& "validating word"
:: ~& wordcombos
=/ i 0
|-
?: =(i (lent wordcombos))
%.n
:: ~& (snag i wordcombos)
?: (word-compare (snag i wordcombos) cword)
%.y
%= $
i +(i)
==
:: ?: ?& (validate-alph-aonly )
:: (validate-complete-alpha )
:: (validate-word )
:: ==
:: %.y
:: %.n
++ get-combos
|= n=(list [@t @t])
=/ i 1
=/ outlist `(list tape)`(snoc `(list tape)`(snoc *(list tape) (trip +2:(snag 0 `(list [@t @t])`n))) (trip +3:(snag 0 `(list [@t @t])`n)))
:: ~& outlist
|-
?: =(i (lent n))
outlist
:: ?: =(i 0)
:: %= $
:: outlist (snoc `(list tape)`(snoc `(list tape)`outlist (trip +2:(snag 0 `(list [@t @t])`n))) (trip +3:(snag 0 `(list [@t @t])`n)))
:: i +(i)
:: ==
=/ j 0
=/ temp *(list tape)
|-
?: =(j (lent outlist))
%= ^$
outlist temp
i +(i)
==
%= $
:: temp (snoc (snoc `(list tape)`outlist (trip +2:(snag 0 `(list [@t @t])`n))) (trip +3:(snag 0 `(list [@t @t])`n)))
temp (snoc `(list tape)`(snoc `(list tape)`temp (snoc (snag j outlist) +2:(snag i `(list [@t @t])`n))) (snoc (snag j outlist) +3:(snag i `(list [@t @t])`n)))
j +(j)
==
:: %= $
:: i +(i)
:: j 3
:: ==
++ word-compare
|= [combo=tape cword=tape]
=/ i 0
:: ~& combo
:: ~& cword
|-
:: ~& combo
?: =(i (lent cword))
%.y
?: =(~ (find (trip (snag i cword)) combo))
%.n
%= $
combo (oust [+3:(find (trip (snag i cword)) combo) 1] combo)
i +(i)
==
++ to-lowercase
|= blocks=(list [@t @t])
=/ lcase *(list [@t @t])
=/ i 0
|-
?: =(i (lent blocks))
:: lcase
:: ~& lcase
lcase
=/ m (crip (cass (trip +2:(snag i blocks))))
=/ n (crip (cass (trip +3:(snag i blocks))))
%= $
lcase (snoc `(list [@t @t])`lcase [m n])
:: lcase (snoc `(list [@t @t])`lcase ['a' 'b'])
i +(i)
==
:: blocks
:: %.n
--
```

574
content/guides/additional/workbook/luhn-number.md Normal file
View File

@ -0,0 +1,574 @@
+++
title = "Luhn Number"
weight = 48
+++
## Challenge: Luhn Number
The Luhn test is used by some credit card companies to distinguish valid credit card numbers from what could be a random selection of digits.
A Luhn number is a sequence of digits that passes the following test:
1. Reverse the order of the digits.
2. Take the first, third, and every odd-numbered digit in the reversed digits and sum them to form `s1`
3. Taking the second, fourth, and every even-numbered digit in the reversed digits:
1. Multiply each by two. Within each doubled digit, sum those digits (if the answer is greater than nine) to form partial sums.
2. Sum the partial sums of the even digits to form `s2`
4. If `s1 + s2` ends in zero then the original number is in the form of a valid credit card number as verified by the Luhn test.
For example, if the trial number is 49927398716:
```
Reverse the digits:
61789372994
Sum the odd digits:
6 + 7 + 9 + 7 + 9 + 4 = 42 = s1
The even digits:
1, 8, 3, 2, 9
Two times each even digit:
2, 16, 6, 4, 18
Sum the digits of each multiplication:
2, 7, 6, 4, 9
Sum the last:
2 + 7 + 6 + 4 + 9 = 28 = s2
s1 + s2 = 70 ends in zero, which means that 49927398716 passes the Luhn test
```
Your task for this challenge is as follows. First you will write a library file `lib/luhn-number` with a core containing an arm named `++validate`. `validate` will be a gate that takes as input a `tape` which is a sequence of digits, and returns either a `%.y` or `%.n` if the number is a Luhn number or not.
Example usage:
```
> =ln -build-file %/lib/luhn-number/hoon
> (validate:ln "49927398716")
%.y
> (validate:ln "1234")
%.n
```
Next you will write a generator file `gen/luhn-number` which takes as input a `tape` which consists of digits or the `*` character, such as:
```
"*1*25**574*18403"
"****"
"584"
```
It will return a `(list tape)` which contains all of the Luhn numbers that fit that format. The numbers should be in lexicographic order (smallest to largest by first digit, then second digit, and so on). You may choose to import and use your `++validate` arm, or perhaps use some other strategy.
Example usage:
```
> +luhn-number "**123"
["01123" "15123" "20123" "39123" "44123" "58123" "63123" "77123" "82123" "96123" ~]
> +luhn-number "123"
~
> +luhn-number "49927398716"
[49927398716 ~]
```
Some notes:
* We take the input as a `tape` rather than a `@ud` because a potential credit card number can have leading zeros.
* Note that in Hoon, we index starting from 0 -- so the first digit will be in the 0th index, second in 1st index, and so on.
* This website may be of use for both checking if a number is Luhn and generating a list from missing digits: https://www.dcode.fr/luhn-algorithm
* Don't worry about numbers with less than 2 digits, or improperly formatted input (with letters and spaces etc.). You can assume that the input tape will have the correct format.
## Unit Tests
Following a principle of test-driven development, we compose a series of tests which allow us to rigorously check for expected behavior.
```
/+ *test
/+ ln=luhn-number
/= luhn-number /gen/luhn-number
|%
:: test valid numbers
::
++ test-01
%+ expect-eq
!> %.y
!> (validate:ln "49927398716")
++ test-02
%+ expect-eq
!> %.y
!> (validate:ln "1234567812345670")
++ test-03
%+ expect-eq
!> %.y
!> (validate:ln "4417123456789105")
++ test-04
%+ expect-eq
!> %.y
!> (validate:ln "20210917131347022")
++ test-05
%+ expect-eq
!> %.y
!> (validate:ln "1806040794512")
++ test-06
%+ expect-eq
!> %.y
!> (validate:ln "9856849794512")
++ test-07
%+ expect-eq
!> %.y
!> (validate:ln "5995841300227")
++ test-08
%+ expect-eq
!> %.y
!> (validate:ln "00")
++ test-09
%+ expect-eq
!> %.y
!> (validate:ln "34")
++ test-10
%+ expect-eq
!> %.y
!> (validate:ln "00005991")
++ test-11
%+ expect-eq
!> %.y
!> (validate:ln "02310568590238405")
:: test invalid numbers
::
++ test-12
%+ expect-eq
!> %.n
!> (validate:ln "1234")
++ test-13
%+ expect-eq
!> %.n
!> (validate:ln "92")
++ test-14
%+ expect-eq
!> %.n
!> (validate:ln "00001463")
++ test-15
%+ expect-eq
!> %.n
!> (validate:ln "754717798")
++ test-16
%+ expect-eq
!> %.n
!> (validate:ln "507274573")
++ test-17
%+ expect-eq
!> %.n
!> (validate:ln "2342352356198234238")
++ test-18
%+ expect-eq
!> %.n
!> (validate:ln "02310568590238406")
++ test-19
%+ expect-eq
!> %.n
!> (validate:ln "5019876543217144")
++ test-20
%+ expect-eq
!> %.n
!> (validate:ln "220743131719012023")
:: test number generation
::
++ test-21
%+ expect-eq
!> `(list tape)`["01123" "15123" "20123" "39123" "44123" "58123" "63123" "77123" "82123" "96123" ~]
!> (luhn-number "**123")
++ test-22
%+ expect-eq
!> `(list tape)`~
!> (luhn-number "123")
++ test-23
%+ expect-eq
!> `(list tape)`["12345690" ~]
!> (luhn-number "12345690")
++ test-24
%+ expect-eq
!> `(list tape)`["023259872" "123259871" "223259870" "323259879" "423259878" "523259877" "623259876" "723259875" "823259874" "923259873" ~]
!> (luhn-number "*2325987*")
++ test-25
%+ expect-eq
!> `(list tape)`["845927593912820" ~]
!> (luhn-number "8459275*3912820")
++ test-26
%+ expect-eq
!> `(list tape)`["00" "18" "26" "34" "42" "59" "67" "75" "83" "91" ~]
!> (luhn-number "**")
++ test-27
%+ expect-eq
!> `(list tape)`["4002" "4192" "4242" "4382" "4432" "4572" "4622" "4762" "4812" "4952" ~]
!> (luhn-number "4**2")
++ test-28
%+ expect-eq
!> `(list tape)`["10017" "10157" "10207" "10397" "10447" "10587" "10637" "10777" "10827" "10967" "11007" "11197" "11247" "11387" "11437" "11577" "11627" "11767" "11817" "11957" "12047" "12187" "12237" "12377" "12427" "12567" "12617" "12757" "12807" "12997" "13037" "13177" "13227" "13367" "13417" "13557" "13607" "13797" "13847" "13987" "14027" "14167" "14217" "14357" "14407" "14597" "14647" "14787" "14837" "14977" "15057" "15107" "15297" "15347" "15487" "15537" "15677" "15727" "15867" "15917" "16097" "16147" "16287" "16337" "16477" "16527" "16667" "16717" "16857" "16907" "17087" "17137" "17277" "17327" "17467" "17517" "17657" "17707" "17897" "17947" "18077" "18127" "18267" "18317" "18457" "18507" "18697" "18747" "18887" "18937" "19067" "19117" "19257" "19307" "19497" "19547" "19687" "19737" "19877" "19927" ~]
!> (luhn-number "1***7")
--
```
## Solutions
_These solutions were submitted by the Urbit community as part of a competition in ~2023.6. They are made available under the MIT License. We ask you to acknowledge authorship should you utilize these elsewhere._
### Solution #1
_By ~dozreg-toplud._
`lib/luhn-number.hoon`
```
:: lib/luhn-number.hoon
:: Library for HSL challenge #3
::
|%
:: ++validate: gate defined in the challenge
::
++ validate
|= a=tape
^- ?
=. a (flop a)
=/ a-digits=(list @) (turn a (cury slav %ud))
=/ s1=@ (roll (skim-odd a-digits) add)
=; s2=@
=(0 (mod (add s1 s2) 10))
%+ roll
(skim-even a-digits)
:: (gate that adds digits of 2*i to the accumulator)
::
|= [i=@ acc=@]
=+ i2=(mul i 2)
:(add acc (div i2 10) (mod i2 10))
:: ++skim-odd: return elements of a list with odd indices (1-indexed)
::
++ skim-odd
|* a=(list)
^+ a
?~ a
~
?~ t.a
~[i.a]
[i.a $(a t.t.a)]
:: ++skim-even: return elements of a list with even indices (1-indexed)
::
++ skim-even
|* a=(list)
^+ a
?: |(?=(~ a) ?=(~ t.a))
~
[i.t.a $(a t.t.a)]
::
--
```
`gen/luhn-number.hoon`
```
:: gen/luhn-number.hoon
:: Naked generator for HSL challenge #3
::
/+ *luhn-number
::
|= a=tape
^- (list tape)
=* this-gate ..$
=/ index-tar=(unit @) (find "*" a)
:: if no * in `a`,
::
?~ index-tar
:: then return empty list if `a` is not a Luhn number, else return list
:: with `a`
::
?. (validate a)
~
~[a]
:: else, replace first * with a digit, call this gate for each digit 0-9,
:: weld the results
::
=/ dry-snap ^~((bake snap ,[tape @ char]))
%- zing
%+ turn
"0123456789"
(cork (cury (cury dry-snap a) u.index-tar) this-gate)
```
### Solution #2
_By ~pardun-nollev. Our speed winner_
`lib/luhn-number.hoon`
```
|%
++ validate
|= input=tape
=/ input (flop input)
=(0 (mod (add (get-s1 input) (get-s2 input)) 10))
++ get-s1
|= input=tape
^- @ud
(roll (odd-digits input) add)
++ get-s2
|= input=tape
^- @ud
(roll (multiply-digits (convert-digits-to-text (double-digits input))) add)
:: take a tape
:: convert to @ud and sum
++ sum-digits
|= input=tape
^- @ud
(roll (turn input |=(a=@t (rash a dem))) add)
:: take list of tapes
:: convert to digits
:: multiply each list of digits
++ multiply-digits
|= input=(list tape)
^- (list @ud)
(turn input |=(a=tape (sum-digits a)))
:: take each number
:: convert to tape
++ convert-digits-to-text
|= input=(list @ud)
^- (list tape)
(turn input |=(a=@ud (scow %ud a)))
:: get even digits and multiply by two
++ double-digits
|= input=tape
^- (list @ud)
(turn (even-digits input) |=(a=@ud (mul a 2)))
++ get-element
|= [idx=@ud input=tape]
^- tape
?: (gte (lent input) +(idx))
`tape`~[(snag idx input)]
~
++ odd-digits
|= input=tape
^- (list @ud)
=/ output=tape ~
|-
?: =(input ~)
(turn output |=(a=@t (rash a dem)))
%= $
output (weld output (get-element 0 input))
input (oust [0 2] input)
==
++ even-digits
|= input=tape
^- (list @ud)
=/ output=tape ~
|-
?: =(input ~)
(turn output |=(a=@t (rash a dem)))
%= $
output (weld output (get-element 1 input))
input (oust [0 2] input)
==
--
```
`gen/luhn-number.hoon`
```
/+ luhn-number
|= input=tape
=<
(skim `(list tape)`(get-permutations input) validate:luhn-number)
|%
++ digits "0123456789"
++ get-permutations
|= input=tape
=/ output=(list tape) ~[input]
=/ idx 0
|-
?: =(idx (lent input))
output
%= $
output (churn-numbers idx output)
idx +(idx)
==
++ churn-numbers
|= [idx=@ud input=(list tape)]
^- (list tape)
(zing (turn input |=(a=tape (generate-perms idx a))))
++ generate-perms
|= [idx=@ud input=tape]
^- (list tape)
?: =((snag idx input) '*')
(turn digits |=(a=@t (snap input idx a)))
~[input]
--
```
### Solution #3
_By ~motdeg-bintul_
`lib/luhn-number`
```
:: lib/luhn-number.hoon
:: Your code goes here
::
|%
++ validate
|= a=tape
&(=((checkdits a) 0) (gth (lent a) 0))
++ checkdits
|= a=tape
=/ totalsum (add (s1 a) (s2 a))
=/ sumtape (trip `@t`(scot %ud totalsum))
=/ digits (scan sumtape (star dit))
:: ~& (odds a)
:: ~& (doubler a)
:: ~& `(list @)`(getsums (doubler a))
:: ~& (s1 a)
:: ~& (s2 a)
:: ~& totalsum
?: (lte totalsum 9)
+2:digits
(snag (sub (lent +3:digits) 1) `(list @ud)`+3:digits)
++ odds
|= a=tape
=/ reverse (flop a)
=/ count 0
|-
^- (list @ud)
|-
?: (gte count (lent reverse))
~
:- (scan (trip (snag count reverse)) dit)
$(count (add 2 count))
++ s1
|= a=tape
(roll `(list @ud)`(odds a) add)
++ evens
|= a=tape
=/ reverse (flop a)
=/ count 1
|-
^- (list @ud)
|-
?: (gte count (lent reverse))
~
:- (scan (trip (snag count reverse)) dit)
$(count (add 2 count))
++ double
|= [a=@]
(mul 2 a)
++ doubler
|= a=tape
(turn `(list @ud)`(evens a) double)
++ adddit
|= [a=(list @ud) b=@ud]
=/ list1 a
=/ list2 `(list @t)`(turn list1 (cury scot %ud))
=/ count b
=/ digits (scan (trip (snag count list2)) (star dit))
=/ d1 (snag 0 digits)
?: =((lent digits) 1)
`@ud`d1
?: (gth (lent digits) 1)
`@ud`(add d1 (snag 1 digits))
~
++ getsums
|= a=(list @ud)
=/ nums a
=/ count 0
|-
?: (lth count (lent nums))
:- (adddit nums count)
$(count (add 1 count))
?: =(count (lent nums))
~
$(count (add 1 count))
++ s2
|= a=tape
=/ nums (doubler a)
(roll `(list @)`(getsums nums) add)
--
```
`gen/luhn-number`
```
:: gen/luhn-number.hoon
:: Your code goes here
::
/= ln /lib/luhn-number
|= a=tape
=<
(checkmissing a)
|%
++ missingnums
|= a=tape
=/ count 0
|-
?: =(count (lent a))
~
?: =((snag count a) '*')
:- count
$(count (add 1 count))
?: =(count (sub (lent a) 1))
~
$(count (add 1 count))
++ replaceast
|= a=tape
=/ pos `(list @)`(missingnums a)
=/ count 0
=/ newtape a
=/ num `@t`(scot %ud 0)
|-
?: =(count (sub (lent pos) 1))
`(list @t)`(snap newtape (snag count pos) num)
%= $
newtape (snap newtape (snag count pos) num)
count (add count 1)
==
++ replacedigits
|= [a=tape b=@ud]
=/ count 0
=/ dits (trip (crip (replaceast a)))
=/ newdits (a-co:co b)
=/ flopdits (flop newdits)
=/ indexcap (sub (lent flopdits) 1)
=/ pos (flop `(list @ud)`(missingnums a))
=/ newnum `tape`dits
|-
?: =(count (lent newdits))
newnum
%= $
newnum `tape`(snap newnum (snag count pos) (snag count flopdits))
count (add 1 count)
==
++ testnewnum
|= a=tape
=/ format a
=/ count 0
=/ countdit (a-co:co count)
=/ newnum `tape`~
=/ pos `(list @ud)`(missingnums format)
=/ dgtlent (lent pos)
|-
^- (list tape)
?: &(=((lent (a-co:co count)) (add 1 dgtlent)) =((validate:ln newnum) %.y))
[newnum ~]
?: =((lent (a-co:co count)) (add 1 dgtlent))
~
?: =((validate:ln newnum) %.y)
:- newnum
%= $
count (add 1 count)
newnum (replacedigits format count)
countdit (a-co:co count)
==
?: =((lent countdit) (add 1 dgtlent))
~
%= $
count (add 1 count)
newnum (replacedigits format count)
countdit (trip `@t`(scot %ud count))
==
++ checkmissing
|= a=tape
?: &(=((missingnums a) ~) =((validate:ln a) %.y))
`(list tape)`[a ~]
(testnewnum a)
--
```

381
content/guides/additional/workbook/water-towers.md Normal file
View File

@ -0,0 +1,381 @@
+++
title = "Water Towers"
weight = 48
+++
## Challenge: Water between Towers
In a two-dimensional world, we begin with a bar-chart, or rows of unit-width 'towers' of arbitrary height. Then it rains, completely filling all convex enclosures in the chart with water.
```
9 ██ 9 ██
8 ██ 8 ██
7 ██ ██ 7 ██≈≈≈≈≈≈≈≈██
6 ██ ██ ██ 6 ██≈≈██≈≈≈≈██
5 ██ ██ ██ ████ 5 ██≈≈██≈≈██≈≈████
4 ██ ██ ████████ 4 ██≈≈██≈≈████████
3 ██████ ████████ 3 ██████≈≈████████
2 ████████████████ ██ 2 ████████████████≈≈██
1 ████████████████████ 1 ████████████████████
```
Your task for this challenge is to write a generator `water-towers`. It will take as input a `(list @ud)`, with each number representing the height of a tower from left to right. It will output a `@ud` representing the units of water that can be contained within the structure.
Example usage:
```
> +water-towers [5 3 7 2 6 4 5 9 1 2 ~]
14
```
## Unit Tests
Following a principle of test-driven development, we compose a series of tests which allow us to rigorously check for expected behavior.
```
/+ *test
/= water-towers /gen/water-towers
|%
++ test-01
%+ expect-eq
!> `@ud`2
!> (water-towers [1 5 3 7 2 ~])
++ test-02
%+ expect-eq
!> `@ud`14
!> (water-towers [5 3 7 2 6 4 5 9 1 2 ~])
++ test-03
%+ expect-eq
!> `@ud`35
!> (water-towers [2 6 3 5 2 8 1 4 2 2 5 3 5 7 4 1 ~])
++ test-04
%+ expect-eq
!> `@ud`0
!> (water-towers [5 5 5 5 ~])
++ test-05
%+ expect-eq
!> `@ud`0
!> (water-towers [5 6 7 8 ~])
++ test-06
%+ expect-eq
!> `@ud`0
!> (water-towers [8 7 7 6 5 4 3 2 ~])
++ test-07
%+ expect-eq
!> `@ud`0
!> (water-towers [0 1 6 7 10 7 6 1 0 ~])
++ test-08
%+ expect-eq
!> `@ud`0
!> (water-towers [100 0 0 0 0 0 0 0 ~])
++ test-09
%+ expect-eq
!> `@ud`7
!> (water-towers [100 0 0 0 0 0 0 0 1 ~])
++ test-10
%+ expect-eq
!> `@ud`50
!> (water-towers [10 0 0 0 0 0 10 ~])
++ test-11
%+ expect-eq
!> `@ud`4
!> (water-towers [8 7 8 7 8 7 8 7 8 ~])
++ test-12
%+ expect-eq
!> `@ud`40
!> (water-towers [0 1 2 3 4 5 4 3 2 1 1 2 3 4 5 4 3 2 1 1 2 3 4 5 4 3 2 1 0 ~])
--
```
## Solutions
_These solutions were submitted by the Urbit community as part of a competition in ~2023.6. They are made available under the GNU License. We ask you to acknowledge authorship should you utilize these elsewhere._
### Solution #1
_Solution by ~dannul-bortux. A model for literate programming._
```
::
:: A gate for computing volume of water collected between towers.
::
:: Take a list (of type list @ud), with each value representing the height of
:: a tower from left to right. Outputs a @ud representing the units of water
:: that can be contained within the structure.
::
:: Our approach involves calculating the total volume of rainfall or water by
:: aggregating the water volume from each tower location. For a specific
:: tower location. water volume is determined by subtracting the “height”
:: of the tower with maximum rainfall (“total height with water”) from the
:: height of the tower alone. Tower heights are given by corresponding values
:: in the input list.
::
:: The “total height with water” at a location is determined by the height of
:: surrounding boundary towers within our structure. Each tower location will
:: have at most two boundary towers: one boundary tower on either side (left
:: and right). The left boundary tower is defined as the highest tower to the
:: left of our specified tower location. The right boundary tower is defined
:: as the highest tower to the right of our specified tower location. The
:: value of “total height with water” at a location is equal to the lesser of
:: the two boundary tower heights (the minimum of the left boundary tower
:: height vs. right boundary tower height). When less than two boundary
:: towers are present, the “total height with water” is equal to the height
:: of the tower itself because no water can be contained without boundaries.
::
|= inlist=(list @ud)
^- @ud
:: If, input list is empty
::
?: =(0 (lent inlist))
:: Then, throw error
::
~| 'Error - input list cannot be empty'
!!
=< (compute-totalvol inlist)
|%
::
:: +compute-totalvol: Gets total volume of water by summing water at each
:: individual location.
::
:: Moves left to right iterating over each location (index in list).
:: Determines waterfall at each location and aggregates all waterfall to
:: find and return total volume.
::
++ compute-totalvol
|= [n=(list @ud)]
^- @ud
:: i is face for iterating over all index/locations
::
=/ i 0
:: tot is face for aggregating volume of water
::
=/ tot 0
|-
:: If, we're at end of input list
::
?: =(i (lent n))
:: then, return total
::
tot
:: else, compute water volume at current index, add to total, and increment i
::
%= $
tot (add tot (compute-indvol i n))
i +(i)
==
::
:: +compute-indvol: Computes volume at an individual location.
::
:: Computes volume at an individual location (index in input list) by
:: subtracting tower height from “total height with water”. “Total height
:: with water” will be determined at a particular location by the height of
:: “boundary towers” for that location.
::
++ compute-indvol
|= [loc=@ud n=(list @ud)]
^- @ud
(sub (compute-waterheight loc n) (snag loc `(list @ud)`n))
::
:: +compute-waterheight: Measures the “total height with water” at a specified
:: index/location.
::
:: “Total height with water” at a particular location is measured using the
:: heights (value) at the left and right boundary towers. The lesser of these
:: two values (left height vs right height) is equal to the “total height
:: with water” at our input location.
::
:: Right boundary tower is the tallest tower to the right of the location--
:: i.e. highest value (height) with higher index. The left boundary tower is
:: the tallest tower to the left of the location i.e. highest value (height)
:: with lower index.
::
:: The “find-boundaryheight” arm iterates left to right and works for
:: measuring height of the right boundary tower. For the left boundary tower
:: we can use a mirror approach. We reverse the input list and adjust the
:: input index accordinglyto move right-to-left.
::
:: In the case where no right or left boundary tower exists, our
:: “find-boundaryheight” arm will return the tower height at our current
:: index (indicating no water present) and we correctly compute 0 water
:: volume in our compute-indvol arm.
::
++ compute-waterheight
|= [loc=@ud n=(list @ud)]
^- @ud
:: rbth is a face for our "right boundary tower height" computed using our
:: "find-boundaryheight" arm moving left to right
::
=/ rbth (find-boundaryheight loc n)
:: lbth is a face for our "right boundary tower height" computed using our
:: "find-boundaryheight" arm moving (mirrored) right to left
::
=/ lbth (find-boundaryheight (sub (lent n) +(loc)) (flop n))
:: If, right boundary tower height is less than left boundary tower height,
::
?: (lth rbth lbth)
:: then, return right boundary tower height
::
rbth
:: else, return left boundary tower height
::
lbth
::
:: +find-boundaryheight: Computes the height of the highest tower to the right
:: of the input location
::
:: Moves left to right starting at input location until the end of input
:: list. Tracks height of each tower location with a height greater than
:: height at corresponding input location.
::
++ find-boundaryheight
|= [loc=@ud n=(list @ud)]
^- @ud
:: i is face used to iterate over input list starting one past input index
::
=/ i +(loc)
:: bheight is face used to measure boundary tower heights--i.e. any tower
:: heights greater than height at input location. At start, bheight is set to
:: input location height. If no greater heights are found, input location
:: height is returned (indicating no higher boundary towers found).
::
=/ bheight (snag loc n)
|-
:: If, we are at the end of our input
::
?: (gte i (lent n))
:: then, return boundary tower height
::
bheight
:: else, if current tower height is greater than currently stored boundary
:: tower height, replace boundary tower height. Incr iteration idx.
::
%= $
bheight ?: (gth (snag i n) bheight)
(snag i n)
bheight
i +(i)
==
--
```
### Solution #2
_By ~racfer-hattes. Short and elegant. Also the speed winner, clocking in at an incredible 29 minutes._
```
=>
|%
++ go
|= [current=@ud previous=(list @ud) next=(list @ud)]
=/ left-peak (roll previous max)
=/ right-peak (roll next max)
=/ min-peak (min left-peak right-peak)
=/ water-level
?: (lth min-peak current) 0
(sub min-peak current)
?~ next water-level
(add water-level $(current i.next, next t.next, previous [current previous]))
--
|= xs=(list @ud)
?~ xs 0
%- go [i.xs ~ t.xs]
```
### Solution #3
_By ~dozreg-toplud. Another very literate and clean solution._
```
:: +water-towers: a solution to the HSL challenge #1
::
:: https://github.com/tamlut-modnys/template-hsl-water-towers
:: Takes a (list @ud) of tower heights, returns the number of the units of
:: water that can be held in the given structure.
::
|= towers=(list @ud)
^- @ud
=<
:: x, y are horizontal and vertical axes
::
=| water-counter=@ud
=/ x-last-tower=@ud (dec (lent towers))
=/ y-highest-tower=@ud (roll towers max)
:: iterate along y axis from y=0
::
=/ y=@ud 0
|-
^- @ud
:: if, y > max(towers)
::
?: (gth y y-highest-tower)
:: then, return water-counter
::
water-counter
:: else, iterate along x axis from x=1
::
=/ x=@ud 1
|-
^- @ud
:: if, x = x(last tower)
::
?: =(x x-last-tower)
:: then, go to the next y
::
^$(y +(y))
:: else, increment water-counter if the point [x y] is not occupied by a tower
:: and has towers to the left and right on the same y, after go to the next x
::
=? water-counter ?& (not-tower x y)
(has-tower-left x y)
(has-tower-right x y)
==
+(water-counter)
$(x +(x))
::
:: Core with helping functions
::
|%
:: ++not-tower: returns %.y if the coordinate [x y] is free from a tower,
:: %.n if occupied.
::
++ not-tower
|= [x=@ud y=@ud]
^- ?
(gth y (snag x towers))
:: ++has-tower-left: returns %.y if there is a tower with height >= y to
:: the left from x, %.n otherwise. Enabled computation caching to only test
:: each point once.
::
++ has-tower-left
|= [x=@ud y=@ud]
~+
^- ?
:: no towers to the left from the 0th tower
::
?: =(x 0)
%.n
:: check recursively to the left
::
?| (gte (snag (dec x) towers) y)
$(x (dec x))
==
:: ++has-tower-right: returns %.y if there is a tower with height >= y to
:: the right from x, %.n otherwise. Enabled computation caching to only test
:: each point once.
::
++ has-tower-right
|= [x=@ud y=@ud]
~+
^- ?
:: no towers to the right from the last tower
::
?: =(x (dec (lent towers)))
%.n
:: check recursively to the right
::
?| (gte (snag +(x) towers) y)
$(x +(x))
==
::
--
```