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
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
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
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
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')
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
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))."
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'
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
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
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 }
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)
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
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"
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
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
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
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
Other "Hello World" solutions.
module [hello]
hello : Str
hello = "Hello, World!"
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
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
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'
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
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
Other "Leap" solutions.
module [isLeapYear]
isLeapYear : I64 -> Bool
isLeapYear = \year ->
year % 4 == 0 &&
year % 100 != 0 || year % 400 == 0
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
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
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
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
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
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
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
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
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
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"
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
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')
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
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
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
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
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 _ -> ""
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
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 }
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
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
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
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
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),
]
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
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
[]
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 }
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
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
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)
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
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 }
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 {})
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."
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 ""
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