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!

  • Andy@programming.devOPM
    link
    fedilink
    arrow-up
    2
    ·
    3 months ago

    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 reverse
    
    Raindrops
    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 >ROMAN
    
    Protein 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
    ;
    
    • Andy@programming.devOPM
      link
      fedilink
      arrow-up
      1
      ·
      3 months ago
      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 ;
      
  • Andy@programming.devOPM
    link
    fedilink
    arrow-up
    1
    ·
    edit-2
    20 days ago
    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 ;
    
  • Andy@programming.devOPM
    link
    fedilink
    arrow-up
    1
    ·
    3 months ago
    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
    ;
    
    • Andy@programming.devOPM
      link
      fedilink
      arrow-up
      1
      ·
      3 months ago
      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
      ;
      
  • Andy@programming.devOPM
    link
    fedilink
    arrow-up
    1
    ·
    2 months ago
    Pangram
    USING: sets.extras unicode ;
    
    : pangram? ( str -- ? )
      >lower "abcdefghijklmnopqrstuvwxyz" superset? ;
    
  • Andy@programming.devOPM
    link
    fedilink
    arrow-up
    1
    ·
    edit-2
    3 months ago
    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 ;
    
    • Andy@programming.devOPM
      link
      fedilink
      arrow-up
      1
      ·
      3 months ago
      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 ;
      
      • Andy@programming.devOPM
        link
        fedilink
        arrow-up
        1
        ·
        3 months ago
        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 ;
        
        • Andy@programming.devOPM
          link
          fedilink
          arrow-up
          1
          ·
          3 months ago
          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 ;
          
          • Andy@programming.devOPM
            link
            fedilink
            arrow-up
            1
            ·
            2 months ago
            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 ;
            
  • Andy@programming.devOPM
    link
    fedilink
    arrow-up
    1
    ·
    2 months ago
    Difference of Squares
    USING: kernel math math.statistics ranges sequences ;
    
    : difference-of-squares ( n -- n' )
      [1..b] [ sum sq ] [ sum-of-squares ] bi - abs ;