Just because Exercism doesn’t offer your favorite language as an official track, it doesn’t mean we can’t play at all. Post some solutions to the weekly challenges in the language of your choice!
You must log in or register to comment.
Fantastic!
Here are a bunch in Factor, taking the easy way when the solution is already in the standard library:
Leap
USING: calendar ; ALIAS: leap? leap-year?Reverse String
USING: sequences ; ALIAS: reverse-string reverseRaindrops
USING: kernel math.functions math.parser sequences ; : raindrops ( n -- sound ) { 3 5 7 } [ dupd divisor? ] map [ { "Pling" "Plang" "Plong" } nth "" ? ] map-index concat [ number>string ] [ nip ] if-empty ;Roman Numerals
USING: roman ; ALIAS: roman-numerals >ROMANProtein Translation
USING: combinators grouping kernel sequences sequences.extras sets ; : RNA>proteins ( RNA -- proteins ) 3 group [ { "UAA" "UAG" "UGA" } in? ] cut-when drop [ { { [ dup "AUG" = ] [ "Methionine" ] } { [ dup "UGG" = ] [ "Tryptophan" ] } { [ dup { "UUU" "UUC" } in? ] [ "Phenylalanine" ] } { [ dup { "UUA" "UUG" } in? ] [ "Leucine" ] } { [ dup { "UAU" "UAC" } in? ] [ "Tyrosine" ] } { [ dup { "UGU" "UGC" } in? ] [ "Cysteine" ] } { [ dup { "UCU" "UCC" "UCA" "UCG" } in? ] [ "Serine" ] } } cond nip ] map ;Acronym
USING: sequences sequences.extras splitting unicode ; : >TLA ( phrase -- TLA ) " -" split [ [ Letter? ] filter ] map-harvest [ 1 head >upper ] map-concat ;Allergies
USING: kernel math sequences sets ; CONSTANT: scores { "eggs" "peanuts" "shellfish" "strawberries" "tomatoes" "chocolate" "pollen" "cats" } : (allergy-test) ( allergens remainder -- allergens' remainder' ) dup log2 [ scores ?nth '[ _ suffix! ] dip ] [ 2^ - ] bi ; : allergy-test ( allergen total -- allergic? allergens ) V{ } clone swap [ (allergy-test) ] until-zero sift dup [ in? ] dip ;Raindrops, again
USING: assocs kernel math.functions math.parser sequences sequences.extras ; : raindrops ( n -- sound ) { 3 5 7 } [ dupd divisor? ] find-all keys { "Pling" "Plang" "Plong" } nths concat [ number>string ] [ nip ] if-empty ;
Luhn
USING: combinators.short-circuit.smart kernel math math.functions math.parser sequences sequences.extras sets unicode ; : luhn? ( str -- ? ) " " without dup { [ length 2 < ] [ [ digit? ] all? not ] } || [ drop f ] [ string>digits reverse [ <evens> sum ] [ <odds> ] bi [ 2 * dup 9 > [ 9 - ] when ] map-sum + 10 divisor? ] if ;Luhn, again
USING: combinators.short-circuit.smart kernel math math.parser rosetta-code.luhn-test sequences sets unicode ; : ex-luhn? ( str -- ? ) " " without dup { [ length 2 < ] [ [ digit? ] all? not ] } || [ drop f ] [ string>number luhn? ] if ;Luhn, a third time
USING: combinators.short-circuit.smart kernel math sequences sets unicode validators ; : ex-luhn? ( str -- ? ) " " without dup { [ length 2 < ] [ [ digit? ] all? not ] } || [ drop f ] [ luhn? ] if ;
Scrabble Score
USING: assocs kernel sequences sets unicode ; MEMO: char>score ( char -- n ) { { 1 "AEIOULNRST" } { 2 "DG" } { 3 "BCMP" } { 4 "FHVWY" } { 5 "K" } { 8 "JX" } { 10 "QZ" } } [ nip dupd in? ] assoc-find 2drop nip ; : scrabble-score ( str -- n ) >upper [ char>score ] map-sum ;Scrabble Score, again
USING: combinators kernel sequences sets unicode ; MEMO: char>score ( char -- n ) { { [ dup "AEIOULNRST" in? ] [ 1 ] } { [ dup "DG" in? ] [ 2 ] } { [ dup "BCMP" in? ] [ 3 ] } { [ dup "FHVWY" in? ] [ 4 ] } { [ dup "K" in? ] [ 5 ] } { [ dup "JX" in? ] [ 8 ] } { [ dup "QZ" in? ] [ 10 ] } } cond nip ; : scrabble-score ( str -- n ) >upper [ char>score ] map-sum ;Scrabble Score, a third time
USING: assocs.extras kernel make sequences unicode ; : scrabble-score ( str -- n ) >upper [ "AEIOULNRST" [ 1 swap ,, ] each "DG" [ 2 swap ,, ] each "BCMP" [ 3 swap ,, ] each "FHVWY" [ 4 swap ,, ] each "K" [ 5 swap ,, ] each "JX" [ 8 swap ,, ] each "QZ" [ 10 swap ,, ] each ] H{ } make swap values-of sum ;Scrabble Score, 3.5
USING: assocs.extras kernel literals make sequences unicode ; CONSTANT: charscores $[ [ "AEIOULNRST" [ 1 swap ,, ] each "DG" [ 2 swap ,, ] each "BCMP" [ 3 swap ,, ] each "FHVWY" [ 4 swap ,, ] each "K" [ 5 swap ,, ] each "JX" [ 8 swap ,, ] each "QZ" [ 10 swap ,, ] each ] H{ } make ] : scrabble-score ( str -- n ) charscores swap >upper values-of sum ;Scrabble Score 4.0
USING: assocs.extras kernel literals make sequences unicode ; CONSTANT: charscores $[ [ { 1 2 3 4 5 8 10 } { "AEIOULNRST" "DG" "BCMP" "FHVWY" "K" "JX" "QZ" } [ [ ,, ] with each ] 2each ] H{ } make ] : scrabble-score ( str -- n ) charscores swap >upper values-of sum ;
Difference of Squares
USING: kernel math math.statistics ranges sequences ; : difference-of-squares ( n -- n' ) [1..b] [ sum sq ] [ sum-of-squares ] bi - abs ;Pangram
USING: sets.extras unicode ; : pangram? ( str -- ? ) >lower "abcdefghijklmnopqrstuvwxyz" superset? ;Space Age
USING: assocs calendar math math.extras ; CONSTANT: year-factors H{ { "Mercury" 0.2408467 } { "Venus" 0.61519726 } { "Earth" 1.0 } { "Mars" 1.8808158 } { "Jupiter" 11.862615 } { "Saturn" 29.447498 } { "Uranus" 84.016846 } { "Neptune" 164.79132 } } : space-age ( seconds planet -- earth-years ) year-factors at years duration>seconds / 2 round-to-decimal ;
