Accumulate

Other "Accumulate" solutions.

module [accumulate]

accumulate : List a, (a -> b) -> List b
accumulate = \list, func ->
    helper list func []

helper : List a, (a -> b), List b -> List b
helper = \list, fn, acc ->
    when list is
        [] -> acc
        [x, .. as rest] ->
            newAcc = List.append acc (fn x)
            helper rest fn newAcc

Allergies

Other "Allergies" solutions.

module [allergicTo, set]

Allergen : [Eggs, Peanuts, Shellfish, Strawberries, Tomatoes, Chocolate, Pollen, Cats]

allergies = [Eggs, Peanuts, Shellfish, Strawberries, Tomatoes, Chocolate, Pollen, Cats]

allergicTo : Allergen, U64 -> Bool
allergicTo = \allergen, score ->
    mask = Num.bitwiseAnd score (allergyScores allergen)
    mask != 0

set : U64 -> Set Allergen
set = \score ->
    List.keepIf allergies \allergen -> allergicTo allergen score
    |> Set.fromList

allergyScores = \allergen ->
    when allergen is
        Eggs -> 1
        Peanuts -> 2
        Shellfish -> 4
        Strawberries -> 8
        Tomatoes -> 16
        Chocolate -> 32
        Pollen -> 64
        Cats -> 128

Anagram

Other "Anagram" solutions.

module [findAnagrams]

import unicode.Grapheme

findAnagrams : Str, List Str -> List Str
findAnagrams = \subject, candidates ->
    List.walk
        candidates
        []
        \acc, candidate ->
            if isAnagram subject candidate then
                List.append acc candidate
            else
                acc

isAnagram = \word, candidate ->
    wordLower = toLowerCase word
    candidateLower = toLowerCase candidate
    if wordLower == candidateLower then
        Bool.false
    else
        charOccurrences wordLower == charOccurrences candidateLower

charOccurrences = \word ->
    graphemes = Grapheme.split word |> Result.withDefault []
    List.walk
        graphemes
        (Dict.empty {})
        (\acc, grapheme ->
            value = Dict.get acc grapheme |> Result.withDefault 0
            Dict.insert acc grapheme (value + 1)
        )

toLowerCase = \word ->
    word
    |> Str.toUtf8
    |> List.map toLower
    |> Str.fromUtf8
    |> Result.withDefault ""

toLower = \byte ->
    if byte >= 'A' && byte <= 'Z' then byte + 32 else byte

Armstrong Numbers

Other "Armstrong Numbers" solutions.

module [isArmstrongNumber]

isArmstrongNumber : U64 -> Bool
isArmstrongNumber = \number ->
    digits =
        getDigits number
    digitSum =
        List.walk
            digits
            0
            \sum, digit ->
                pow =
                    Num.powInt digit (List.len digits)
                sum + pow

    digitSum == number

getDigits : U64 -> List U64
getDigits = \number ->
    bytes =
        Num.toStr number
        |> Str.toUtf8
        |> List.map (\byte -> byte - '0')
        |> List.map Num.toU64
    bytes

Atbash Cipher

Other "Atbash Cipher" solutions.

module [encode, decode]

encode : Str -> Result Str _
encode = \phrase ->
    phrase
    |> Str.toUtf8
    |> List.keepIf isAlphaNumeric
    |> List.map toLower
    |> List.chunksOf 5
    |> List.walkTry [] \sentence, chunk ->
        encoded = encodeChunk chunk
        Result.map (Str.fromUtf8 encoded) \encodedChunk ->
            List.append sentence encodedChunk
    |> Result.map \l -> Str.joinWith l " "

encodeChunk : List U8 -> List U8
encodeChunk = \chunk ->
    reversedAlphabet = List.reverse alphabet
    List.keepOks chunk \c ->
        if isNumeric c then
            Ok c
        else
            idx = List.findFirstIndex? alphabet (\el -> c == el)
            List.get reversedAlphabet idx

decode : Str -> Result Str _
decode = \phrase ->
    reversedAlphabet = List.reverse alphabet
    phrase
        |> Str.toUtf8
        |> List.keepIf isAlphaNumeric
        |> List.keepOks \c ->
            if isNumeric c then
                Ok c
            else
                idx = List.findFirstIndex? reversedAlphabet (\el -> c == el)
                List.get alphabet idx
        |> Str.fromUtf8

alphabet = Str.toUtf8 "abcdefghijklmnopqrstuvwxyz"

toLower = \c -> if c >= 'A' && c <= 'Z' then c + 32 else c

isAlphaNumeric = \c ->
    lowered = toLower c
    (lowered >= 'a' && lowered <= 'z') || isNumeric lowered

isNumeric = \c -> (c >= '0' && c <= '9')

Binary

Other "Binary" solutions.

module [decimal]

b0 = 48
b1 = 49

decimal : Str -> Result U64 _
decimal = \binaryStr ->
    isBinary = List.all (Str.toUtf8 binaryStr) (\c -> c == b0 || c == b1)
    if isBinary then
        Ok (countBinary binaryStr)
    else
        Err "Must provide a binary string"

countBinary : Str -> U64
countBinary = \binaryStr ->
    binaryStr
    |> Str.toUtf8
    |> List.reverse
    |> List.mapWithIndex
        (\byte, i ->
            if byte == b1 then
                Num.powInt 2 i
            else
                0
        )
    |> List.sum

Binary Search

Other "Binary Search" solutions.

module [find]

find : List U64, U64 -> Result U64 _
find = \array, target ->
    when array is
        [] -> Err NotPresent
        [only] -> if only == target then Ok 0 else Err NotPresent
        items ->
            pivot = List.len items // 2
            guess = List.get items pivot

            when guess is
                Ok x if x == target ->
                    Ok pivot

                Ok x if x > target ->
                    cutoff = List.len items - pivot
                    xs = List.dropLast items cutoff
                    find xs target

                Ok _ ->
                    xs = List.dropFirst items pivot
                    Result.map (find xs target) (\i -> i + pivot)

                Err OutOfBounds -> crash "The pivot point $(Num.toStr pivot) should never be out of bounds for list of length $(Num.toStr (List.len array))."

Bob

Other "Bob" solutions.

module [response]

response : Str -> Str
response = \heyBob ->
    sanitized = Str.trim heyBob
    isQuestion = Str.endsWith sanitized "?"
    isSilence = sanitized == ""
    isYelling = strIsYelling sanitized

    if isSilence then
        "Fine. Be that way!"
    else if isQuestion && isYelling then
        "Calm down, I know what I'm doing!"
    else if isQuestion then
        "Sure."
    else if isYelling then
        "Whoa, chill out!"
    else
        "Whatever."

strIsYelling = \str ->
    alphas = List.keepIf (Str.toUtf8 str) isAlpha
    List.len alphas > 0 && List.all alphas isCapitalLetter

isAlpha : U8 -> Bool
isAlpha = \byte ->
    (byte >= 'a' && byte <= 'z') || isCapitalLetter byte

isCapitalLetter : U8 -> Bool
isCapitalLetter = \byte ->
    byte >= 'A' && byte <= 'Z'

Clock

Other "Clock" solutions.

module [create, toStr, add, subtract]

Clock : { hour : U8, minute : U8 }

create : { hours ? I64, minutes ? I64 }* -> Clock
create = \{ hours ? 0, minutes ? 0 } ->
    totalMinutes = (hours * 60 + minutes) % (24 * 60)
    normalizedMinutes =
        if totalMinutes < 0 then
            totalMinutes + 24 * 60
        else
            totalMinutes
    {
        hour: Num.intCast ((normalizedMinutes // 60) % 24),
        minute: Num.intCast (normalizedMinutes % 60),
    }

toStr : Clock -> Str
toStr = \{ hour, minute } ->
    hours = clockDigitToStr hour
    minutes = clockDigitToStr minute
    "$(hours):$(minutes)"

add : Clock, { hours ? I64, minutes ? I64 }* -> Clock
add = \clock, { hours ? 0, minutes ? 0 } ->
    create {
        hours: Num.toI64 clock.hour + hours,
        minutes: Num.toI64 clock.minute + minutes,
    }

subtract : Clock, { hours ? I64, minutes ? I64 }* -> Clock
subtract = \clock, { hours ? 0, minutes ? 0 } ->
    add clock { hours: -hours, minutes: -minutes }

### Private

clockDigitToStr : U8 -> Str
clockDigitToStr = \digit ->
    if digit < 10 then
        "0$(Num.toStr digit)"
    else
        Num.toStr digit

Collatz Conjecture

Other "Collatz Conjecture" solutions.

module [steps]

steps : U64 -> Result U64 [InvalidInput]
steps = \n ->
    if n < 1 then
        Err InvalidInput
    else
        Ok (collatzCount 0 n)

collatzCount : U64, U64 -> U64
collatzCount = \stepCount, n ->
    val =
        if n % 2 == 0 then
            (n // 2)
        else
            (3 * n + 1)

    if n == 1 then
        stepCount
    else
        collatzCount (stepCount + 1) val

Complex Numbers

Other "Complex Numbers" solutions.

module [real, imaginary, add, sub, mul, div, conjugate, abs, exp]

Complex : { re : F64, im : F64 }

real : Complex -> F64
real = \{ re } -> re

imaginary : Complex -> F64
imaginary = \{ im } -> im

add : Complex, Complex -> Complex
add = \{ re: a, im: b }, { re: c, im: d } -> { re: a + c, im: b + d }

sub : Complex, Complex -> Complex
sub = \{ re: a, im: b }, { re: c, im: d } -> { re: a - c, im: b - d }

mul : Complex, Complex -> Complex
mul = \{ re: a, im: b }, { re: c, im: d } -> { re: a * c - b * d, im: b * c + a * d }

div : Complex, Complex -> Complex
div = \{ re: a, im: b }, { re: c, im: d } -> {
    re: (a * c + b * d) / (c ^ 2 + d ^ 2),
    im: (b * c - a * d) / (c ^ 2 + d ^ 2),
}

conjugate : Complex -> Complex
conjugate = \{ re: a, im: b } -> { re: a, im: -b }

abs : Complex -> F64
abs = \{ re: a, im: b } -> Num.sqrt (a * a + b * b)

exp : Complex -> Complex
exp = \{ re: a, im: b } ->
    ea = Num.e |> Num.pow a
    { re: ea * Num.cos b, im: ea * Num.sin b }

Crypto Square

Other "Crypto Square" solutions.

module [ciphertext]

ciphertext : Str -> Result Str _
ciphertext = \text ->
    chars =
        text
        |> Str.toUtf8
        |> List.map \c -> if c >= 'A' && c <= 'Z' then c + 32 else c
        |> List.keepIf \c -> (c >= 'a' && c <= 'z') || (c >= '0' && c <= '9')

    (_, colCount) = findRectangle (List.len chars)

    rows = List.chunksOf chars colCount

    cols = List.range { start: At 0, end: Before colCount }

    encodedChars = List.map cols \colIdx ->
        List.map rows \row ->
            row
            |> List.get colIdx
            |> Result.withDefault ' '

    words =
        List.intersperse encodedChars [' ']
        |> List.join

    Str.fromUtf8 words

findRectangle = \strLength ->
    candidateC =
        strLength
        |> Num.toF32
        |> Num.sqrt
        |> Num.ceiling

    loop = \c ->
        r = Num.ceiling (Num.toFrac strLength / Num.toFrac c)
        if c >= r && c - r <= 1 then
            (r, c)
        else
            loop (c + 1)

    loop candidateC

expect
    result = findRectangle 54
    result == (7, 8)

Darts

Other "Darts" solutions.

module [score]

score : F64, F64 -> U64
score = \x, y ->
    r = Num.sqrt (x ^ 2 + y ^ 2)

    when r is
        _ if r <= 1 -> 10
        _ if r <= 5 -> 5
        _ if r <= 10 -> 1
        _ -> 0

Diamond

Other "Diamond" solutions.

module [diamond]

diamond : U8 -> Str
diamond = \letter ->
    midPoint = Num.toU64 letter - 'A'
    width = Num.toU64 ((Num.toU64 midPoint) * 2) + 1

    topHalf = List.range { start: At 'A', end: At letter }
    bottomHalf = List.range { start: At 'A', end: Before letter }

    generateRow = \char ->
        charStr = Result.withDefault (Str.fromUtf8 [char]) ""
        row = List.repeat " " width
        offsetFromMiddle = Num.toU64 char - Num.toU64 'A'
        (pos1, pos2) = (midPoint - offsetFromMiddle, midPoint + offsetFromMiddle)

        row
        |> List.set pos1 charStr
        |> List.set pos2 charStr
        |> Str.joinWith ""

    rows = List.concat (List.map topHalf generateRow) (List.reverse (List.map bottomHalf generateRow))

    Str.joinWith rows "\n"

Difference Of Squares

Other "Difference Of Squares" solutions.

module [squareOfSum, sumOfSquares, differenceOfSquares]

# squareOfSum : U64 -> U64
# squareOfSum = \number ->
#     loop =
#         \sum ->
#             if sum == number then
#                 sum
#             else
#                 sum + loop (sum + 1)
#     summation = loop 1
#     Num.powInt summation 2

squareOfSum : U64 -> U64
squareOfSum = \number ->
    List.sum (List.range { start: At 1, end: At number }) |> Num.powInt 2

sumOfSquares : U64 -> U64
sumOfSquares = \number ->
    List.map
        (List.range { start: At 1, end: At number })
        \n -> n * n
    |> List.sum

differenceOfSquares : U64 -> U64
differenceOfSquares = \number ->
    squareOfSum number - sumOfSquares number

Etl

Other "Etl" solutions.

module [transform]

transform : Dict U64 (List U8) -> Dict U8 U64
transform = \legacy ->
    Dict.walk legacy (Dict.empty {}) \acc, score, letters ->
        letters
        |> List.map \letter -> (toLower letter, score)
        |> Dict.fromList
        |> Dict.insertAll acc

toLower = \char -> if char >= 'A' && char <= 'Z' then char + ('a' - 'A') else char

Grains

Other "Grains" solutions.

module [grainsOnSquare, totalGrains]

grainsOnSquare : U8 -> Result U64 _
grainsOnSquare = \square ->
    if square > 0 && square <= 64 then
        Ok (Num.powInt 2 ((Num.toU64 square) - 1))
    else
        Err NotAChessSquare

totalGrains : U64
totalGrains = Num.maxU64

Hamming

Other "Hamming" solutions.

module [distance]

distance : Str, Str -> Result U64 _
distance = \strand1, strand2 ->
    list1 = Str.toUtf8 strand1
    list2 = Str.toUtf8 strand2

    if List.len list1 != List.len list2 then
        Err InvalidInput
        else

    List.map2 list1 list2 Pair
    |> List.countIf \Pair s1 s2 -> s1 != s2
    |> Ok

Hello World

Other "Hello World" solutions.

module [hello]

hello : Str
hello = "Hello, World!"

Hexadecimal

Other "Hexadecimal" solutions.

module [parse]

parse : Str -> Result U64 _
parse = \string ->
    if string == "" then
        Err Empty
        else

    hexadecimals =
        string
        |> Str.toUtf8
        |> List.reverse
        |> List.mapTry hexByteToDecimal

    Result.try hexadecimals \l ->
        List.walkWithIndex l (Ok 0) \resultSum, digit, i ->
            when resultSum is
                Ok sum ->
                    if digit > 0 && i > 16 then
                        Err Overflow
                        else

                    safeMultiply = Num.mulChecked (Num.powInt 16 i) digit
                    newValue = Result.try safeMultiply \x -> Num.addChecked sum x
                    newValue

                Err _ ->
                    resultSum
hexByteToDecimal = \hex ->
    lower = if hex >= 'A' && hex <= 'Z' then hex + 32 else hex
    when lower is
        '0' -> Ok 0
        '1' -> Ok 1
        '2' -> Ok 2
        '3' -> Ok 3
        '4' -> Ok 4
        '5' -> Ok 5
        '6' -> Ok 6
        '7' -> Ok 7
        '8' -> Ok 8
        '9' -> Ok 9
        'a' -> Ok 10
        'b' -> Ok 11
        'c' -> Ok 12
        'd' -> Ok 13
        'e' -> Ok 14
        'f' -> Ok 15
        _ -> Err NotHex

High Scores

Other "High Scores" solutions.

module [latest, personalBest, personalTopThree]

Score : U64

latest : List Score -> Result Score _
latest = List.last

personalBest : List Score -> Result Score _
personalBest = List.max

personalTopThree : List Score -> List Score
personalTopThree = \scores ->
    scores
    |> List.sortDesc
    |> List.takeFirst 3

Isbn Verifier

Other "Isbn Verifier" solutions.

module [isValid]

isValid : Str -> Bool
isValid = \isbn ->
    sanitized =
        isbn
        |> Str.toUtf8
        |> List.dropIf \c -> c == '-'

    if List.len sanitized != 10 then
        Bool.false
        else

    checkDigit =
        sanitized
        |> List.last
        |> Result.map \c -> if c == 'X' then 10 else c - '0'

    digits =
        sanitized
        |> List.dropLast 1
        |> List.keepIf isDigit
        |> List.map \c -> c - '0'
        |> List.appendIfOk checkDigit

    checkSum = List.walkWithIndex digits (Num.toU64 0) \state, digit, idx ->
        multiplier = 10 - idx
        state + ((Num.toU64 digit) * multiplier)

    checkSum % 11 == 0

isDigit = \c -> c >= '0' && c <= '9'

Isogram

Other "Isogram" solutions.

module [isIsogram]

isIsogram : Str -> Bool
isIsogram = \phrase ->
    sanitized =
        phrase
        |> Str.toUtf8
        |> List.map toLowerCase
        |> List.keepIf isAlpha
    List.len sanitized == Set.fromList sanitized |> Set.len

isAlpha = \char ->
    lower = toLowerCase char
    lower >= 'a' && lower <= 'z'

toLowerCase = \char ->
    when char is
        _ if char >= 'A' && char <= 'Z' -> char + 32
        _ -> char

Kindergarten Garden

Other "Kindergarten Garden" solutions.

module [plants]

Student : [Alice, Bob, Charlie, David, Eve, Fred, Ginny, Harriet, Ileana, Joseph, Kincaid, Larry]
Plant : [Grass, Clover, Radishes, Violets]

plants : Str, Student -> Result (List Plant) _
plants = \diagram, student ->
    rows = Str.split diagram "\n"
    (row1Result, row2Result) = (List.get rows 0, List.get rows 1)
    plantResult = Result.map2
        row1Result
        row2Result
        \row1Str, row2Str ->
            idx = studentNumber student * plantsPerStudent

            row1 = Str.toUtf8 row1Str |> List.dropFirst idx
            row2 = Str.toUtf8 row2Str |> List.dropFirst idx

            plantsFromRow1 = List.takeFirst row1 plantsPerStudent
            plantsFromRow2 = List.takeFirst row2 plantsPerStudent

            List.concat plantsFromRow1 plantsFromRow2
    Result.map plantResult \result -> List.keepOks result toPlant

toPlant = \plantStr ->
    when plantStr is
        'V' -> Ok Violets
        'R' -> Ok Radishes
        'C' -> Ok Clover
        'G' -> Ok Grass
        _ -> Err UnsupportedPlant

plantsPerStudent = 2

studentNumber = \student ->
    when student is
        Alice -> 0
        Bob -> 1
        Charlie -> 2
        David -> 3
        Eve -> 4
        Fred -> 5
        Ginny -> 6
        Harriet -> 7
        Ileana -> 8
        Joseph -> 9
        Kincaid -> 10
        Larry -> 11

Leap

Other "Leap" solutions.

module [isLeapYear]

isLeapYear : I64 -> Bool
isLeapYear = \year ->
    year % 4 == 0 &&
    year % 100 != 0 || year % 400 == 0

Matching Brackets

Other "Matching Brackets" solutions.

module [isPaired]

isPaired : Str -> Bool
isPaired = \string ->
    chars =
        string
        |> Str.toUtf8
        |> List.keepIf isBracket

    bracketStack = List.walkTry chars [] \stack, char ->
        when (stack, char) is
            (_, '{') -> Ok (List.append stack '{')
            (_, '[') -> Ok (List.append stack '[')
            (_, '(') -> Ok (List.append stack '(')
            ([.. as rest, '{'], '}') -> Ok rest
            ([.. as rest, '['], ']') -> Ok rest
            ([.. as rest, '('], ')') -> Ok rest
            (_, ')') -> Err Unbalanced
            (_, ']') -> Err Unbalanced
            (_, '}') -> Err Unbalanced
            _ -> Ok stack

    when bracketStack is
        Ok [] -> Bool.true
        _ -> Bool.false

isBracket = \c ->
    set = Set.fromList ['{', '}', '(', ')', '[', ']']
    Set.contains set c

Matrix

Other "Matrix" solutions.

module [row, column]

column : Str, U64 -> Result (List I64) _
column = \matrixStr, index ->
    rowCount = List.len (Str.split matrixStr "\n")
    rowIndices = List.range { start: At 1, end: At rowCount }
    theRows = List.keepOks rowIndices \idx -> row matrixStr idx

    walkRows : List I64, List I64 -> List I64
    walkRows = \col, theRow ->
        int = List.get theRow (index - 1)
        when int is
            Ok x -> List.append col x
            Err _ -> col

    colValues = List.walk theRows [] walkRows

    Ok colValues

row : Str, U64 -> Result (List I64) _
row = \matrixStr, index ->
    theRow =
        matrixStr
        |> Str.split "\n"
        |> List.get (index - 1)
    Result.map theRow \rowStr ->
        rowStr
        |> Str.split " "
        |> List.keepOks Str.toI64

Micro Blog

Other "Micro Blog" solutions.

module [truncate]

import unicode.CodePoint

truncate : Str -> Result Str _
truncate = \input ->
    codepoints =
        input
            |> Str.toUtf8
            |> CodePoint.parseUtf8?
    codepoints |> List.takeFirst 5 |> CodePoint.toStr? |> Ok

Nth Prime

Other "Nth Prime" solutions.

module [prime]

prime : U64 -> Result U64 _
prime = \number ->
    loop = \primes, current ->
        next = if current == 2 then 3 else current + 2
        if List.len primes == number then
            List.last primes
        else if isPrime current then
            List.append primes current
            |>
            loop next
        else
            loop primes next

    loop [] 2

isPrime : U64 -> Bool
isPrime = \number ->
    if number < 2 then
        Bool.false
    else if number == 2 then
        Bool.true
    else if number % 2 == 0 then
        Bool.false
    else
        top = Num.sqrt (Num.toF32 number) |> Num.floor
        toCheck = List.range { start: At 3, end: At top, step: 2 }
        anyDivisible = List.any toCheck \el -> number % el == 0
        !anyDivisible

Nucleotide Count

Other "Nucleotide Count" solutions.

module [nucleotideCounts]

nucleotideCounts : Str -> Result { a : U64, c : U64, g : U64, t : U64 } _
nucleotideCounts = \input ->
    counts = { a: 0, c: 0, g: 0, t: 0 }
    Str.walkUtf8
        input
        (Ok counts)
        \acc, char ->
            when char is
                'A' -> Result.map acc (\sums -> { sums & a: sums.a + 1 })
                'C' -> Result.map acc (\sums -> { sums & c: sums.c + 1 })
                'G' -> Result.map acc (\sums -> { sums & g: sums.g + 1 })
                'T' -> Result.map acc (\sums -> { sums & t: sums.t + 1 })
                _ -> Err InvalidNucleotide

Octal

Other "Octal" solutions.

module [parse]

parse : Str -> Result U64 _
parse = \string ->
    if string == "" then
        Err Empty
        else

    octals =
        string
        |> Str.toUtf8
        |> List.reverse
        |> List.mapTry octalToDecimal

    Result.try octals \l ->
        List.walkWithIndex l (Ok 0) \resultSum, digit, i ->
            when resultSum is
                Ok sum ->
                    safeMultiply = Num.mulChecked (Num.powInt 8 i) digit
                    newValue = Result.try safeMultiply \x -> Num.addChecked sum x
                    newValue

                Err _ ->
                    resultSum

octalToDecimal = \octal ->
    lower = if octal >= 'A' && octal <= 'Z' then octal + 32 else octal
    when lower is
        '0' -> Ok 0
        '1' -> Ok 1
        '2' -> Ok 2
        '3' -> Ok 3
        '4' -> Ok 4
        '5' -> Ok 5
        '6' -> Ok 6
        '7' -> Ok 7
        _ -> Err NotHex

Pangram

Other "Pangram" solutions.

module [isPangram]

isPangram : Str -> Bool
isPangram = \sentence ->
    chars =
        sentence
        |> Str.toUtf8
        |> List.map toLowerCase
        |> Set.fromList
    List.all alphas \char -> Set.contains chars char

alphas : List U8
alphas = List.range { start: At 'a', end: At 'z' }

toLowerCase : U8 -> U8
toLowerCase = \char -> if char >= 'A' && char <= 'Z' then char + 32 else char

Phone Number

Other "Phone Number" solutions.

module [clean]

clean : Str -> Result Str _
clean = \phoneNumber ->
    phoneNumber
    |> Str.toUtf8
    |> List.keepIf \c -> c >= '0' && c <= '9'
    |> validateLength
    |> Result.try validateAreaCode
    |> Result.try validateExchangeCode
    |> Result.try Str.fromUtf8

validateAreaCode : List U8 -> Result (List U8) _
validateAreaCode = \phoneNumberBytes ->
    when phoneNumberBytes is
        [head, ..] if head >= '2' && head <= '9' -> Ok phoneNumberBytes
        _ ->
            Err Invalid

validateExchangeCode : List U8 -> Result (List U8) _
validateExchangeCode = \phoneNumberBytes ->
    exchangeCode = List.get phoneNumberBytes 3
    when exchangeCode is
        Ok value if value >= '2' && value <= '9' -> Ok phoneNumberBytes
        _ -> Err Invalid

validateLength : List U8 -> Result (List U8) _
validateLength = \phoneNumberBytes ->
    len = List.len phoneNumberBytes
    if len == 10 then
        Ok phoneNumberBytes
    else if len == 11 then
        when phoneNumberBytes is
            [first, .. as rest] if first == '1' -> Ok rest
            _ -> Err Invalid
    else
        Err Invalid

Protein Translation

Other "Protein Translation" solutions.

module [toProtein]

AminoAcid : [Cysteine, Leucine, Methionine, Phenylalanine, Serine, Tryptophan, Tyrosine]
Protein : List AminoAcid

toProtein : Str -> Result Protein _
toProtein = \rna ->
    instructions =
        rna
        |> Str.toUtf8
        |> List.chunksOf 3
        |> List.map \l -> Str.fromUtf8 l |> Result.withDefault ""
        |> List.map codonToInstruction

    collectProtein = \protein, codonInstructions ->
        when codonInstructions is
            [] -> Ok protein
            [instruction, .. as rest] ->
                when instruction is
                    Ok (Append aminoAcid) ->
                        appended = List.append protein aminoAcid
                        collectProtein appended rest

                    Ok Stop -> Ok protein
                    Err e -> Err e

    collectProtein [] instructions

Instruction : [Append AminoAcid, Stop]

codonToInstruction : Str -> Result Instruction _
codonToInstruction = \codon ->
    when codon is
        "AUG" -> Ok (Append Methionine)
        "UUU" | "UUC" -> Ok (Append Phenylalanine)
        "UUA" | "UUG" -> Ok (Append Leucine)
        "UCU" | "UCC" | "UCA" | "UCG" -> Ok (Append Serine)
        "UAU" | "UAC" -> Ok (Append Tyrosine)
        "UGU" | "UGC" -> Ok (Append Cysteine)
        "UGG" -> Ok (Append Tryptophan)
        "UAA" | "UAG" | "UGA" -> Ok Stop
        _ -> Err Unknown

Proverb

Other "Proverb" solutions.

module [recite]

recite : List Str -> Str
recite = \strings ->
    loop = \idx, acc ->
        catalyst = Result.withDefault (List.first strings) ""
        words = List.sublist strings { start: idx, len: 2 }

        newLine =
            when words is
                [a, b] -> "For want of a $(a) the $(b) was lost."
                [_] -> "And all for the want of a $(catalyst)."
                _ -> ""

        proverb = List.append acc newLine

        if idx + 1 < List.len strings then
            loop (idx + 1) proverb
        else
            proverb

    Str.joinWith (loop 0 []) "\n"

Pythagorean Triplet

Other "Pythagorean Triplet" solutions.

module [tripletsWithSum]

Triplet : (U64, U64, U64)

tripletsWithSum : U64 -> Set Triplet
tripletsWithSum = \n ->
    possibleAValues = List.range { start: At 1, end: At (n // 3) }
    possibleAValues
    |> List.walk (Set.empty {}) \triplets, a ->
        # Calculate values of B and C.
        # I asked Claude how to do this because I was stuck :/
        b = (n * (n - 2 * a)) // (2 * (n - a))
        c = n - a - b

        # Check if it's a valid Pythagorean triplet
        if a * a + b * b == c * c && a < b && b < c then
            Set.insert triplets (a, b, c)
        else
            triplets

Queen Attack

Other "Queen Attack" solutions.

module [create, rank, file, queenCanAttack]

Square := { row : U8, column : U8 }

rank : Square -> U8
rank = \@Square { row } -> 8 - row

file : Square -> U8
file = \@Square { column } -> column + 'A'

create : Str -> Result Square [InvalidSquare]
create = \squareStr ->
    chars = Str.toUtf8 squareStr
    fileResult = List.get chars 0
    rankResult = List.get chars 1
    Result.map2 fileResult rankResult \fileChar, rankChar -> (fileChar, rankChar)
    |> Result.mapErr \OutOfBounds -> InvalidSquare
    |> Result.try \(fileChar, rankChar) ->
        column = fileChar - 'A'
        if rankChar < '1' || rankChar > '8' then
            Err InvalidSquare
        else if fileChar < 'A' || fileChar > 'H' then
            Err InvalidSquare
        else
            Ok (@Square { row: rankToRow rankChar, column })

queenCanAttack : Square, Square -> Bool
queenCanAttack = \@Square { row: row1, column: col1 }, @Square { row: row2, column: col2 } ->
    row1Signed = Num.toI32 row1
    row2Signed = Num.toI32 row2
    col1Signed = Num.toI32 col1
    col2Signed = Num.toI32 col2
    row1 == row2 || col1 == col2 || (Num.abs (row1Signed - row2Signed)) == (Num.abs (col1Signed - col2Signed))

rankToRow : U8 -> U8
rankToRow = \rankChar ->
    8 - (rankChar - '0')

Raindrops

Other "Raindrops" solutions.

module [convert]

convert : U64 -> Str
convert = \number ->
    pling = if number % 3 == 0 then "Pling" else ""
    plang = if number % 5 == 0 then "Plang" else ""
    plong = if number % 7 == 0 then "Plong" else ""
    result = Str.joinWith [pling, plang, plong] ""

    if result == "" then
        Num.toStr number
    else
        result

Rectangles

Other "Rectangles" solutions.

module [rectangles]

# Heavy inspiration from Ageron's solution.

rectangles : Str -> U64
rectangles = \diagram ->
    grid =
        Str.split diagram "\n"
        |> List.map Str.toUtf8

    height = List.len grid

    List.mapWithIndex grid \row, y1 ->
        List.mapWithIndex row \_, x1 ->
            y2s = List.range { start: After y1, end: Before height }
            List.map y2s \y2 ->
                x2s = List.range { start: After x1, end: Before (List.len row) }
                List.map x2s \x2 ->
                    if isRectangle grid (x1, y1) (x2, y2) then
                        1
                    else
                        0
                |> List.sum
            |> List.sum
        |> List.sum
    |> List.sum

isRectangle : List (List U8), (U64, U64), (U64, U64) -> Bool
isRectangle = \grid, (x1, y1), (x2, y2) ->
    getGridValue = \x, y ->
        row = List.get? grid y
        value = List.get row x
        value

    hasTopLeftCorner = getGridValue x1 y1 == Ok '+'
    hasBottomLeftCorner = getGridValue x1 y2 == Ok '+'
    hasTopRightCorner = getGridValue x2 y1 == Ok '+'
    hasBottomRightCorner = getGridValue x2 y2 == Ok '+'

    hasTopHorizontalEdge =
        xs = List.range { start: At x1, end: At x2 }
        List.all xs \x ->
            getGridValue x y1 == Ok '+' || getGridValue x y1 == Ok '-'

    hasBottomHorizontalEdge =
        xs = List.range { start: At x1, end: At x2 }
        List.all xs \x ->
            getGridValue x y2 == Ok '+' || getGridValue x y2 == Ok '-'

    hasLeftVerticalEdge =
        ys = List.range { start: At y1, end: At y2 }
        List.all ys \y ->
            getGridValue x1 y == Ok '+' || getGridValue x1 y == Ok '|'

    hasRightVerticalEdge =
        ys = List.range { start: At y1, end: At y2 }
        List.all ys \y ->
            getGridValue x2 y == Ok '+' || getGridValue x2 y == Ok '|'

    List.all
        [
            hasTopLeftCorner,
            hasBottomLeftCorner,
            hasTopRightCorner,
            hasBottomRightCorner,
            hasTopHorizontalEdge,
            hasBottomHorizontalEdge,
            hasLeftVerticalEdge,
            hasRightVerticalEdge,
        ]
        \identity -> identity

Resistor Color

Other "Resistor Color" solutions.

module [colorCode, colors]

colorMap =
    Dict.fromList [
        ("black", 0),
        ("brown", 1),
        ("red", 2),
        ("orange", 3),
        ("yellow", 4),
        ("green", 5),
        ("blue", 6),
        ("violet", 7),
        ("grey", 8),
        ("white", 9),
    ]

colorCode : Str -> Result U64 _
colorCode = \color ->
    Dict.get colorMap color

colors : List Str
colors = Dict.keys colorMap

Resistor Color Duo

Other "Resistor Color Duo" solutions.

module [value]

Color : [
    Black,
    Brown,
    Red,
    Orange,
    Yellow,
    Green,
    Blue,
    Violet,
    Grey,
    White,
]

value : Color, Color -> U8
value = \first, second ->
    firstDigit = colors first * 10
    secondDigit = colors second
    firstDigit + secondDigit

colors = \color ->
    when color is
        Black -> 0
        Brown -> 1
        Red -> 2
        Orange -> 3
        Yellow -> 4
        Green -> 5
        Blue -> 6
        Violet -> 7
        Grey -> 8
        White -> 9

Reverse String

Other "Reverse String" solutions.

module [reverse]

import unicode.Grapheme

reverse : Str -> Str
reverse = \string ->
    when Grapheme.split string is
        Ok chars ->
            chars |> List.reverse |> Str.joinWith ""

        Err _ -> ""

Rna Transcription

Other "Rna Transcription" solutions.

module [toRna]

toRna : Str -> Str
toRna = \dna ->
    dna
    |> Str.toUtf8
    |> List.map nucleoTideComplement
    |> Str.fromUtf8
    |> Result.withDefault ""

nucleoTideComplement = \n ->
    when n is
        'G' -> 'C'
        'C' -> 'G'
        'T' -> 'A'
        'A' -> 'U'
        _ -> n

Robot Simulator

Other "Robot Simulator" solutions.

module [create, move]

Direction : [North, East, South, West]
Robot : { x : I64, y : I64, direction : Direction }

create : { x ? I64, y ? I64, direction ? Direction } -> Robot
create = \{ x ? 0, y ? 0, direction ? North } -> {
    x,
    y,
    direction,
}

move : Robot, Str -> Robot
move = \robot, instructions ->
    instructionBytes = Str.toUtf8 instructions
    List.walk instructionBytes robot applyInstruction

applyInstruction : Robot, U8 -> Robot
applyInstruction = \{ x, y, direction }, instruction ->
    when instruction is
        'L' ->
            newDirection =
                when direction is
                    North -> West
                    South -> East
                    East -> North
                    West -> South
            { x, y, direction: newDirection }

        'R' ->
            newDirection =
                when direction is
                    North -> East
                    East -> South
                    South -> West
                    West -> North
            { x, y, direction: newDirection }

        'A' ->
            when direction is
                North -> { x, y: y + 1, direction }
                East -> { x: x + 1, y, direction }
                South -> { x, y: y - 1, direction }
                West -> { x: x - 1, y, direction }

        _ -> { x, y, direction }

Roman Numerals

Other "Roman Numerals" solutions.

module [roman]

numerals = Dict.fromList [
    (1000, "M"),
    (900, "CM"),
    (500, "D"),
    (400, "CD"),
    (100, "C"),
    (90, "XC"),
    (50, "L"),
    (40, "XL"),
    (10, "X"),
    (9, "IX"),
    (5, "V"),
    (4, "IV"),
    (1, "I"),
]

roman : U64 -> Result Str _
roman = \number ->
    nums =
        numerals
        |> Dict.keys
        |> List.sortDesc

    (resultString, _) = List.walk nums ("", number) \(result, n), denominator ->
        if (n // denominator) >= 1 then
            romanChar = numerals |> Dict.get denominator |> Result.withDefault ""
            newChars = Str.repeat romanChar (n // denominator)
            (Str.concat result newChars, Num.rem n denominator)
        else
            (result, n)

    Ok resultString

Rotational Cipher

Other "Rotational Cipher" solutions.

module [rotate]

rotate : Str, U8 -> Str
rotate = \text, shiftKey ->
    text
    |> Str.toUtf8
    |> List.map \c -> rotateChar c shiftKey
    |> Str.fromUtf8
    |> Result.withDefault ""

rotateChar : U8, U8 -> U8
rotateChar = \char, shiftKey ->
    if char >= 'A' && char <= 'Z' then
        (char - 'A' + shiftKey) % 26 + 'A'
    else if char >= 'a' && char <= 'z' then
        (char - 'a' + shiftKey) % 26 + 'a'
    else
        char

Saddle Points

Other "Saddle Points" solutions.

module [saddlePoints]

Forest : List (List U8)
Position : { row : U64, column : U64 }

saddlePoints : Forest -> Set Position
saddlePoints = \treeHeights ->
    tallestInRows = List.walkWithIndex treeHeights [] \tallestTrees, row, rowIndex ->
        tallest = List.max row |> Result.withDefault 0
        tallestPositionsInRow = List.walkWithIndex row [] \tallestTreesInRow, treeHeight, columnIndex ->
            if treeHeight == tallest then
                List.append tallestTreesInRow ({ row: rowIndex + 1, column: columnIndex + 1 })
            else
                tallestTreesInRow
        List.concat tallestTrees tallestPositionsInRow
    tallestInRowsSet = Set.fromList tallestInRows

    columnCount =
        treeHeights
        |> List.first
        |> Result.map \row -> List.len row
        |> Result.withDefault 0

    columns = List.range { start: At 0, end: Before columnCount }

    shortestInColumns =
        List.joinMap columns \columnIndex ->
            column =
                treeHeights
                |>
                List.mapWithIndex \row, rowIdx ->
                    List.get row columnIndex
                    |> Result.map \treeHeight -> { treeHeight, rowIdx }
                |> List.keepOks identity
            shortest = List.map column .treeHeight |> List.min |> Result.withDefault 0

            column
            |> List.keepIf \{ treeHeight } -> treeHeight == shortest
            |> List.map \{ rowIdx } -> { row: rowIdx + 1, column: columnIndex + 1 }

    shortestInColumnsSet = Set.fromList shortestInColumns
    Set.intersection tallestInRowsSet shortestInColumnsSet

identity = \id -> id

Say

Other "Say" solutions.

module [say]

translations = Dict.fromList [
    (1, "one"),
    (2, "two"),
    (3, "three"),
    (4, "four"),
    (5, "five"),
    (6, "six"),
    (7, "seven"),
    (8, "eight"),
    (9, "nine"),
    (10, "ten"),
    (11, "eleven"),
    (12, "twelve"),
    (13, "thirteen"),
    (14, "fourteen"),
    (15, "fifteen"),
    (16, "sixteen"),
    (17, "seventeen"),
    (18, "eighteen"),
    (19, "nineteen"),
    (20, "twenty"),
    (30, "thirty"),
    (40, "forty"),
    (50, "fifty"),
    (60, "sixty"),
    (70, "seventy"),
    (80, "eighty"),
    (90, "ninety"),
]

magnitudes = [
    (1_000_000_000, "billion"),
    (1_000_000, "million"),
    (1_000, "thousand"),
    (100, "hundred"),
]

sayCompoundWord : U64 -> Str
sayCompoundWord = \number ->
    small = number % 10
    big = number - small
    List.keepOks [big, small] \n -> Dict.get translations n
    |> Str.joinWith ("-")

say : U64 -> Result Str _
say = \number ->
    if number == 0 then
        Ok "zero"
        else

    sayInternal = \n ->
        if n > 999_999_999_999 then
            Err OutOfRange
        else if Dict.contains translations n then
            Dict.get translations n
        else if n < 100 then
            Ok (sayCompoundWord n)
        else
            (magnitude, magnitudeWord) =
                magnitudes
                |> List.dropIf \(m, _) -> m > n
                |> List.first
                |> Result.withDefault (0, "Unreachable")

            quantity = (n // magnitude)

            remainder = n % magnitude

            components = [
                sayInternal quantity,
                Ok magnitudeWord,
                sayInternal remainder,
            ]

            filtered =
                components
                |> List.keepOks \identity -> identity
                |> List.dropIf Str.isEmpty

            Ok (Str.joinWith filtered " ")

    sayInternal number

Scrabble Score

Other "Scrabble Score" solutions.

module [score]

score : Str -> U64
score = \word ->
    word
    |> Str.toUtf8
    |> List.map \char -> if char >= 'A' && char <= 'Z' then char + 32 else char
    |> List.keepOks \char -> Dict.get points char
    |> List.sum

points =
    Dict.fromList [
        ('a', 1),
        ('e', 1),
        ('i', 1),
        ('o', 1),
        ('u', 1),
        ('l', 1),
        ('n', 1),
        ('r', 1),
        ('s', 1),
        ('t', 1),
        ('d', 2),
        ('g', 2),
        ('b', 3),
        ('c', 3),
        ('m', 3),
        ('p', 3),
        ('f', 4),
        ('h', 4),
        ('v', 4),
        ('w', 4),
        ('y', 4),
        ('k', 5),
        ('j', 8),
        ('x', 8),
        ('q', 10),
        ('z', 10),
    ]

Secret Handshake

Other "Secret Handshake" solutions.

module [commands]

actions = [
    (1, "wink"),
    (2, "double blink"),
    (4, "close your eyes"),
    (8, "jump"),
]

commands : U64 -> List Str
commands = \number ->
    commandList = List.walk actions [] \acc, (mask, action) ->
        if Num.bitwiseAnd number mask == mask then
            List.append acc action
        else
            acc
    if Num.bitwiseAnd number 16 == 16 then
        List.reverse commandList
    else
        commandList

Series

Other "Series" solutions.

module [slices]

slices : Str, U64 -> List Str
slices = \string, sliceLength ->
    utf8 = Str.toUtf8 string

    walk = \acc, _, idx ->
        bytes = List.sublist utf8 { start: idx, len: sliceLength }
        substr = Str.fromUtf8 bytes

        if (List.len bytes) == sliceLength then
            when substr is
                Ok s -> List.append acc s
                Err _ -> acc
        else
            acc

    if sliceLength > 0 then
        Str.walkUtf8WithIndex string [] walk
    else
        []

Sieve

Other "Sieve" solutions.

module [primes]

primes : U64 -> List U64
primes = \limit ->
    if limit < 2 then
        []
        else

    loop = \primeValues, nonPrimes, current ->
        if current == limit then
            if !(Set.contains nonPrimes current) then
                List.append primeValues current
            else
                primeValues
        else if Set.contains nonPrimes current then
            loop primeValues nonPrimes (current + 1)
        else
            newPrimes = List.append primeValues current
            newNonPrimes =
                nonPrimes
                |> Set.toList
                |> List.concat (multiplesUpTo current limit)
                |> Set.fromList
            loop newPrimes newNonPrimes (current + 1)

    loop [2] (Set.fromList (multiplesUpTo 2 limit)) 2

multiplesUpTo : U64, U64 -> List U64
multiplesUpTo = \current, limit ->
    List.range { start: At current, end: At limit, step: current }

Space Age

Other "Space Age" solutions.

module [age]

Planet : [
    Mercury,
    Venus,
    Earth,
    Mars,
    Jupiter,
    Saturn,
    Uranus,
    Neptune,
]

earthYearSeconds = 31_557_600

age : Planet, Dec -> Dec
age = \planet, seconds ->
    earthYears = seconds / earthYearSeconds
    earthYears / orbitalPeriod planet

orbitalPeriod = \planet ->
    when planet is
        Mercury -> 0.2408467
        Venus -> 0.61519726
        Earth -> 1.0
        Mars -> 1.8808158
        Jupiter -> 11.862615
        Saturn -> 29.447498
        Uranus -> 84.016846
        Neptune -> 164.79132

Square Root

Other "Square Root" solutions.

module [squareRoot]

squareRoot : U64 -> U64
squareRoot = \radicand ->
    if radicand == 1 then
        1
        else

    guess = radicand // 2

    loop : U64 -> U64
    loop = \previousGuess ->
        newGuess =
            (
                previousGuess
                +
                (radicand // previousGuess)
            )
            // 2

        if (newGuess * newGuess) == radicand then
            newGuess
        else
            loop newGuess

    loop guess

Strain

Other "Strain" solutions.

module [keep, discard]

keep : List a, (a -> Bool) -> List a
keep = \list, predicate ->
    when list is
        [] -> list
        [head, .. as rest] ->
            if predicate head then
                keep rest predicate
                |>
                List.prepend head
            else
                keep rest predicate

discard : List a, (a -> Bool) -> List a
discard = \list, predicate ->
    keep list \elem -> !(predicate elem)

Sublist

Other "Sublist" solutions.

module [sublist]

sublist : List U8, List U8 -> [Equal, Sublist, Superlist, Unequal]
sublist = \list1, list2 ->
    if list1 == list2 then
        Equal
    else if isSublist list1 list2 then
        Superlist
    else if isSublist list2 list1 then
        Sublist
    else
        Unequal

isSublist = \list1, list2 ->
    List.walkWithIndex
        list1
        Bool.false
        \sublistFound, _, idx ->
            if sublistFound then
                sublistFound
                else

            attemptedSublist = List.sublist list1 { start: idx, len: List.len list2 }

            attemptedSublist == list2

Sum Of Multiples

Other "Sum Of Multiples" solutions.

module [sumOfMultiples]

sumOfMultiples : List U64, U64 -> U64
sumOfMultiples = \factors, limit ->
    allMultiples = List.joinMap factors (\factor -> multiplesLessThan factor limit)
    allMultiples |> Set.fromList |> Set.toList |> List.sum

multiplesLessThan = \factor, limit ->
    if factor == 0 then
        [0]
        else

    List.range { start: At factor, end: Before limit, step: factor }

Triangle

Other "Triangle" solutions.

module [isEquilateral, isIsosceles, isScalene]

isEquilateral : (F64, F64, F64) -> Bool
isEquilateral = \(a, b, c) ->
    isTriangle (a, b, c)
    && Num.isApproxEq a b {}
    && Num.isApproxEq b c {}

isIsosceles : (F64, F64, F64) -> Bool
isIsosceles = \(a, b, c) ->
    isTriangle (a, b, c) && (eq a b || eq b c || eq a c)

isScalene : (F64, F64, F64) -> Bool
isScalene = \(a, b, c) ->
    isTriangle (a, b, c) && neq a b && neq b c && neq a c

isTriangle : (F64, F64, F64) -> Bool
isTriangle = \(a, b, c) ->
    (a + b >= c)
    && (b + c >= a)
    && (a + c >= b)
    && List.all [a, b, c] \x -> x > 0

eq : F64, F64 -> Bool
eq = \a, b -> Num.isApproxEq a b {}

neq : F64, F64 -> Bool
neq = \a, b -> !(Num.isApproxEq a b {})

Two Fer

Other "Two Fer" solutions.

module [twoFer]

twoFer : [Name Str, Anonymous] -> Str
twoFer = \name ->
    word =
        when name is
            Anonymous -> "you"
            Name n -> n
    "One for $(word), one for me."

Word Count

Other "Word Count" solutions.

module [countWords]

countWords : Str -> Dict Str U64
countWords = \sentence ->
    sentence
    |> Str.replaceEach "," " "
    |> Str.split " "
    |> List.map sanitizeWord
    |> List.dropIf Str.isEmpty
    |> List.walk (Dict.empty {}) \dict, word ->
        Dict.update dict word \result ->
            when result is
                Ok existing -> Ok (existing + 1)
                Err Missing -> Ok 1

sanitizeWord : Str -> Str
sanitizeWord = \word ->
    word
    |> Str.trim
    |> Str.dropPrefix "'"
    |> Str.dropSuffix "'"
    |> Str.toUtf8
    |> List.map \char -> if char >= 'A' && char <= 'Z' then char + 32 else char
    |> List.keepIf \char -> (char >= 'a' && char <= 'z') || (char >= '0' && char <= '9') || char == '\''
    |> Str.fromUtf8
    |> Result.withDefault ""

Yacht

Other "Yacht" solutions.

module [score]

Category : [Ones, Twos, Threes, Fours, Fives, Sixes, FullHouse, FourOfAKind, LittleStraight, BigStraight, Choice, Yacht]

score : List U8, Category -> U8
score = \dice, category ->
    when category is
        Ones -> scoreNItems dice 1
        Twos -> scoreNItems dice 2
        Threes -> scoreNItems dice 3
        Fours -> scoreNItems dice 4
        Fives -> scoreNItems dice 5
        Sixes -> scoreNItems dice 6
        FourOfAKind -> scoreFourOfAKind dice
        LittleStraight -> scoreLittleStraight dice
        BigStraight -> scoreBigStraight dice
        FullHouse -> scoreFullHouse dice
        Choice -> List.sum dice
        Yacht -> scoreYacht dice

scoreNItems : List U8, U8 -> U8
scoreNItems = \items, n ->
    Num.toU8 (List.countIf items \item -> item == n) * n

scoreLittleStraight : List U8 -> U8
scoreLittleStraight = \dice ->
    required = Set.fromList [1, 2, 3, 4, 5]
    if Set.fromList dice == required then
        30
    else
        0

scoreBigStraight : List U8 -> U8
scoreBigStraight = \dice ->
    required = Set.fromList [2, 3, 4, 5, 6]
    if Set.fromList dice == required then
        30
    else
        0

scoreFullHouse : List U8 -> U8
scoreFullHouse = \dice ->
    counts = getCounts dice
    if Set.fromList (Dict.values counts) == Set.fromList [2, 3] then
        List.sum dice
    else
        0

scoreFourOfAKind : List U8 -> U8
scoreFourOfAKind = \dice ->
    counts = getCounts dice
    Dict.walk counts 0 \total, cast, occurrences ->
        if occurrences >= 4 then total + (cast * 4) else total

scoreYacht : List U8 -> U8
scoreYacht = \dice ->
    counts = getCounts dice
    if Dict.values counts == [5] then
        50
    else
        0

getCounts = \dice ->
    List.walk dice (Dict.empty {}) \dict, cast ->
        Dict.update dict cast \possibleCount ->
            when possibleCount is
                Ok x -> Ok (x + 1)
                Err Missing -> Ok 1