From 33890d8a8b0366f078f359a9e7ad63da24634b9a Mon Sep 17 00:00:00 2001 From: William Carroll Date: Tue, 18 Aug 2020 12:13:00 +0100 Subject: Move scratch/brilliant into //assessments Where it belongs... --- assessments/brilliant/.ghci | 2 + assessments/brilliant/App.hs | 41 ++++++++++++++ assessments/brilliant/Keyboard.hs | 58 ++++++++++++++++++++ assessments/brilliant/Main.hs | 43 +++++++++++++++ assessments/brilliant/README.md | 82 ++++++++++++++++++++++++++++ assessments/brilliant/Spec.hs | 103 ++++++++++++++++++++++++++++++++++++ assessments/brilliant/Transforms.hs | 52 ++++++++++++++++++ assessments/brilliant/Utils.hs | 13 +++++ assessments/brilliant/default.nix | 16 ++++++ assessments/brilliant/shell.nix | 16 ++++++ 10 files changed, 426 insertions(+) create mode 100644 assessments/brilliant/.ghci create mode 100644 assessments/brilliant/App.hs create mode 100644 assessments/brilliant/Keyboard.hs create mode 100644 assessments/brilliant/Main.hs create mode 100644 assessments/brilliant/README.md create mode 100644 assessments/brilliant/Spec.hs create mode 100644 assessments/brilliant/Transforms.hs create mode 100644 assessments/brilliant/Utils.hs create mode 100644 assessments/brilliant/default.nix create mode 100644 assessments/brilliant/shell.nix (limited to 'assessments') diff --git a/assessments/brilliant/.ghci b/assessments/brilliant/.ghci new file mode 100644 index 000000000000..efc88e630ccb --- /dev/null +++ b/assessments/brilliant/.ghci @@ -0,0 +1,2 @@ +:set prompt "> " +:set -Wall diff --git a/assessments/brilliant/App.hs b/assessments/brilliant/App.hs new file mode 100644 index 000000000000..0272988f371c --- /dev/null +++ b/assessments/brilliant/App.hs @@ -0,0 +1,41 @@ +-------------------------------------------------------------------------------- +module App where +-------------------------------------------------------------------------------- +import Keyboard (Keyboard(..)) +import Transforms (Transform(..)) +import Utils ((|>)) + +import qualified Data.Char as Char +import qualified Utils +import qualified Data.List.Split as Split +import qualified Keyboard +import qualified Data.HashMap.Strict as HM +-------------------------------------------------------------------------------- + +transform :: Keyboard -> Transform -> Keyboard + +transform (Keyboard xs) xform = + case xform of + HorizontalFlip -> + xs + |> fmap reverse + |> Keyboard + + VerticalFlip -> + xs + |> reverse + |> Keyboard + + Shift n -> + xs + |> concat + |> Utils.rotate n + |> Split.chunksOf 10 + |> Keyboard + +retypePassage :: String -> Keyboard -> Maybe String +retypePassage passage newKeyboard = + passage + |> fmap Char.toUpper + |> traverse (\c -> HM.lookup c Keyboard.charToCoord) + >>= traverse (Keyboard.coordToChar newKeyboard) diff --git a/assessments/brilliant/Keyboard.hs b/assessments/brilliant/Keyboard.hs new file mode 100644 index 000000000000..13b5de0145aa --- /dev/null +++ b/assessments/brilliant/Keyboard.hs @@ -0,0 +1,58 @@ +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +-------------------------------------------------------------------------------- +module Keyboard where +-------------------------------------------------------------------------------- +import Utils +import Data.Coerce +import Data.Hashable (Hashable) +import GHC.Generics (Generic) + +import qualified Data.List as List +import qualified Data.HashMap.Strict as HM +-------------------------------------------------------------------------------- + +newtype Keyboard = Keyboard [[Char]] + deriving (Eq) + +instance Show Keyboard where + show (Keyboard xxs) = + xxs |> fmap printRow |> List.intercalate "\n" + where + printRow :: [Char] -> String + printRow xs = + xs |> fmap (\x -> '[':x:']':"") |> List.intercalate "" + +data Coord = Coord + { row :: Int + , col :: Int + } deriving (Eq, Show, Generic) + +instance Hashable Coord + +-- | List of characters to their QWERTY coordinatees. +coords :: [(Char, Coord)] +coords = + qwerty + |> coerce + |> fmap (zip [0..]) + |> zip [0..] + |> fmap (\(row, xs) -> xs |> fmap (\(col, char) -> (char, Coord row col))) + |> mconcat + +-- | Mapping of characters to their coordinates on a QWERTY keyboard with the +-- top-left corner as 0,0. +charToCoord :: HM.HashMap Char Coord +charToCoord = HM.fromList coords + +coordToChar :: Keyboard -> Coord -> Maybe Char +coordToChar (Keyboard xxs) Coord{..} = + Just $ xxs !! row !! col + +qwerty :: Keyboard +qwerty = Keyboard [ ['1','2','3','4','5','6','7','8','9','0'] + , ['Q','W','E','R','T','Y','U','I','O','P'] + , ['A','S','D','F','G','H','J','K','L',';'] + , ['Z','X','C','V','B','N','M',',','.','/'] + ] diff --git a/assessments/brilliant/Main.hs b/assessments/brilliant/Main.hs new file mode 100644 index 000000000000..e94c73bea287 --- /dev/null +++ b/assessments/brilliant/Main.hs @@ -0,0 +1,43 @@ +{-# LANGUAGE RecordWildCards #-} +-------------------------------------------------------------------------------- +module Main where +-------------------------------------------------------------------------------- +import Options.Applicative +import Data.Semigroup ((<>)) + +import qualified Transforms +import qualified Keyboard +import qualified App +-------------------------------------------------------------------------------- + +data CommandArgs = CommandArgs + { transforms :: String + , passage :: String + } deriving (Eq, Show) + +parseArgs :: Parser CommandArgs +parseArgs = + CommandArgs <$> strOption + ( long "transforms" + <> short 't' + <> help "String of transforms where (e.g. \"HHVS12VHVHS3\")" ) + <*> strOption + ( long "passage" + <> short 'p' + <> help "Input text to re-type" ) + +main :: IO () +main = do + CommandArgs{..} <- execParser opts + case Transforms.fromString transforms of + Nothing -> putStrLn "You must provide valid input (e.g. \"HHVS12VHVHS3\")" + Just xs -> do + let keyboard = foldl App.transform Keyboard.qwerty (Transforms.optimize xs) + putStrLn $ "Typing: \"" ++ passage ++ "\"\nOn this keyboard:\n" ++ show keyboard + case App.retypePassage passage keyboard of + Nothing -> putStrLn $ "Looks like at least one of the characters in your input passage doesn't fit on our QWERTY keyboard: \n" ++ show Keyboard.qwerty + Just result -> putStrLn $ "Result: " ++ result + where + opts = info (parseArgs <**> helper) + ( fullDesc + <> progDesc "Transform a QWERTY keyboard using a string of commands") diff --git a/assessments/brilliant/README.md b/assessments/brilliant/README.md new file mode 100644 index 000000000000..60d7de4e25ae --- /dev/null +++ b/assessments/brilliant/README.md @@ -0,0 +1,82 @@ +# Transform QWERTY + +Apply a series of transforms to a QWERTY keyboard then use the new keyboard to +re-type a passage of text. + +## Environment + +You will need [Nix][nix] to build this program on your machine. The good news is +that you won't need any Haskell-specific dependencies like `ghc`, `cabal`, or +`stack`: just Nix. + +Once you have Nix installed, to build the program, run the following from this +project's top-level directory: + +```shell +$ nix-build +``` + +This should output an executable named `transform-keyboard` within a `result` +directory: + +```shell +$ tree result +result +└── transform-keyboard +``` + +### Testing + +To run the test suite, run the following from the project's top-level directory: + +```shell +$ nix-shell +$ runhaskell Spec.hs +``` + +[nix]: https://nixos.org/download.html + +## Usage + +Here are some `--help` and usage examples: + +```shell +$ ./result/transform-keyboard --help +Usage: transform-keyboard (-t|--transforms ARG) (-p|--passage ARG) + Transform a QWERTY keyboard using a string of commands + +Available options: + -t,--transforms ARG String of transforms where (e.g. "HHVS12VHVHS3") + -p,--passage ARG Input text to re-type + -h,--help Show this help text +``` + +Now a working example: + +```shell +$ ./result/transform-keyboard --transforms=HHVS12VHVHS3 --passage='Hello,Brilliant.' +Typing: "Hello,Brilliant." +On this keyboard: +[H][J][K][L][;][Q][W][E][R][T] +[Y][U][I][O][P][1][2][3][4][5] +[6][7][8][9][0][Z][X][C][V][B] +[N][M][,][.][/][A][S][D][F][G] +Result: ZIVV4D/O3VV36APF +``` + +...and an example with an erroneous input (i.e. `!`): + +```shell +$ ./result/transform-keyboard --transforms=HHVS12VHVHS3 --passage='Hello,Brilliant!' +Typing: "Hello,Brilliant!" +On this keyboard: +[H][J][K][L][;][Q][W][E][R][T] +[Y][U][I][O][P][1][2][3][4][5] +[6][7][8][9][0][Z][X][C][V][B] +[N][M][,][.][/][A][S][D][F][G] +Looks like at least one of the characters in your input passage doesn't fit on our QWERTY keyboard: +[1][2][3][4][5][6][7][8][9][0] +[Q][W][E][R][T][Y][U][I][O][P] +[A][S][D][F][G][H][J][K][L][;] +[Z][X][C][V][B][N][M][,][.][/] +``` diff --git a/assessments/brilliant/Spec.hs b/assessments/brilliant/Spec.hs new file mode 100644 index 000000000000..e99e025641fa --- /dev/null +++ b/assessments/brilliant/Spec.hs @@ -0,0 +1,103 @@ +-------------------------------------------------------------------------------- +module Spec where +-------------------------------------------------------------------------------- +import Test.Hspec +import Test.QuickCheck +import Keyboard (Keyboard(..)) +import Transforms (Transform(..)) +import Data.Coerce +import Utils + +import qualified App +import qualified Keyboard +import qualified Transforms +-------------------------------------------------------------------------------- + +main :: IO () +main = hspec $ do + describe "Keyboard.print" $ do + it "pretty-prints the keyboard" $ do + show Keyboard.qwerty == "[1][2][3][4][5][6][7][8][9][0]\n[Q][W][E][R][T][Y][U][I][O][P]\n[A][S][D][F][G][H][J][K][L][;]\n[Z][X][C][V][B][N][M][,][.][/]" + + describe "Transforms.fromString" $ do + it "successfully parses a string of commands" $ do + Transforms.fromString "HHVS-12VHVHS3" == + Just [ HorizontalFlip + , HorizontalFlip + , VerticalFlip + , Shift (-12) + , VerticalFlip + , HorizontalFlip + , VerticalFlip + , HorizontalFlip + , Shift 3 + ] + + it "returns Nothing when the input is invalid" $ do + Transforms.fromString "potato" == Nothing + + it "return Nothing when the input is valid except for the end" $ do + Transforms.fromString "HVS10potato" == Nothing + + describe "App.transform" $ do + it "flips any keyboard horizontally" $ do + property $ \first second third fourth -> + App.transform (Keyboard [first, second, third, fourth]) HorizontalFlip == do + Keyboard [ reverse first + , reverse second + , reverse third + , reverse fourth + ] + + it "flips any keyboard vertically" $ do + property $ \first second third fourth -> + App.transform (Keyboard [first, second, third, fourth]) VerticalFlip == do + Keyboard $ reverse [first, second, third, fourth] + + it "shifts any keyboard" $ do + property $ \first second third fourth n -> + App.transform (Keyboard [first, second, third, fourth]) (Shift n) + |> (coerce :: Keyboard -> [[Char]]) + |> concat == + [first, second, third, fourth] + |> concat + |> Utils.rotate n + + it "flips a QWERTY keyboard horizontally" $ do + App.transform Keyboard.qwerty HorizontalFlip == do + Keyboard [ ['0','9','8','7','6','5','4','3','2','1'] + , ['P','O','I','U','Y','T','R','E','W','Q'] + , [';','L','K','J','H','G','F','D','S','A'] + , ['/','.',',','M','N','B','V','C','X','Z'] + ] + + it "flips a keyboard vertically" $ do + App.transform Keyboard.qwerty VerticalFlip == do + Keyboard [ ['Z','X','C','V','B','N','M',',','.','/'] + , ['A','S','D','F','G','H','J','K','L',';'] + , ['Q','W','E','R','T','Y','U','I','O','P'] + , ['1','2','3','4','5','6','7','8','9','0'] + ] + + it "shifts a keyboard left N times" $ do + App.transform Keyboard.qwerty (Shift 2) == do + Keyboard [ ['3','4','5','6','7','8','9','0','Q','W'] + , ['E','R','T','Y','U','I','O','P','A','S'] + , ['D','F','G','H','J','K','L',';','Z','X'] + , ['C','V','B','N','M',',','.','/','1','2'] + ] + + it "shifts right negative amounts" $ do + App.transform Keyboard.qwerty (Shift (-3)) == do + Keyboard [ [',','.','/','1','2','3','4','5','6','7'] + , ['8','9','0','Q','W','E','R','T','Y','U'] + , ['I','O','P','A','S','D','F','G','H','J'] + , ['K','L',';','Z','X','C','V','B','N','M'] + ] + + describe "Transforms.optimize" $ do + it "removes superfluous horizontal transformations" $ do + Transforms.optimize [HorizontalFlip, HorizontalFlip] == [] + + it "removes superfluous vertical transformations" $ do + Transforms.optimize [VerticalFlip, VerticalFlip] == [] diff --git a/assessments/brilliant/Transforms.hs b/assessments/brilliant/Transforms.hs new file mode 100644 index 000000000000..d8df8f8372e0 --- /dev/null +++ b/assessments/brilliant/Transforms.hs @@ -0,0 +1,52 @@ +-------------------------------------------------------------------------------- +module Transforms where +-------------------------------------------------------------------------------- +import Control.Applicative ((<|>)) +import Text.ParserCombinators.ReadP +-------------------------------------------------------------------------------- + +data Transform = VerticalFlip + | HorizontalFlip + | Shift Int + deriving (Eq, Show) + +digit :: ReadP Char +digit = + satisfy (\c -> c >= '0' && c <= '9') + +command :: ReadP Transform +command = vertical + <|> horizontal + <|> shift + where + vertical = + char 'V' >> pure VerticalFlip + + horizontal = + char 'H' >> pure HorizontalFlip + + shift = do + _ <- char 'S' + negative <- option Nothing $ fmap Just (satisfy (== '-')) + n <- read <$> many1 digit + case negative of + Nothing -> pure $ Shift n + Just _ -> pure $ Shift (-1 * n) + +-- | Attempt to remove redundant transformations. +-- | Here are some rules that I'd like to support but may not have time for: +-- | - All even-numbered flips (w/o intermittent shifts) can become zero +-- | - All odd-numbered flips (w/o intermittent shifts) can become 1 +-- | - All shifts can be be reduce to the absolute value of shifts +optimize :: [Transform] -> [Transform] +optimize [] = [] +optimize [x] = [x] +optimize (VerticalFlip:VerticalFlip:xs) = optimize xs +optimize (HorizontalFlip:HorizontalFlip:xs) = optimize xs +optimize xs = xs + +fromString :: String -> Maybe [Transform] +fromString x = + case readP_to_S (manyTill command eof) x of + [(res, "")] -> Just res + _ -> Nothing diff --git a/assessments/brilliant/Utils.hs b/assessments/brilliant/Utils.hs new file mode 100644 index 000000000000..c69d00333b8e --- /dev/null +++ b/assessments/brilliant/Utils.hs @@ -0,0 +1,13 @@ +-------------------------------------------------------------------------------- +module Utils where +-------------------------------------------------------------------------------- +import Data.Function ((&)) +-------------------------------------------------------------------------------- + +(|>) :: a -> (a -> b) -> b +(|>) = (&) + +-- | Rotate `xs` as a cycle `n` times. +rotate :: Int -> [a] -> [a] +rotate n xs = take size . drop (n `mod` size) . cycle $ xs + where size = length xs diff --git a/assessments/brilliant/default.nix b/assessments/brilliant/default.nix new file mode 100644 index 000000000000..886ba87e1caf --- /dev/null +++ b/assessments/brilliant/default.nix @@ -0,0 +1,16 @@ +let + briefcase = import {}; +in briefcase.buildHaskell.program { + name = "transform-keyboard"; + srcs = builtins.path { + path = ./.; + name = "transform-keyboard-src"; + }; + deps = hpkgs: with hpkgs; [ + optparse-applicative + unordered-containers + split + rio + ]; + ghcExtensions = []; +} diff --git a/assessments/brilliant/shell.nix b/assessments/brilliant/shell.nix new file mode 100644 index 000000000000..d0a6c7e5e6f5 --- /dev/null +++ b/assessments/brilliant/shell.nix @@ -0,0 +1,16 @@ +let + pkgs = import (builtins.fetchGit { + url = "https://github.com/NixOS/nixpkgs-channels"; + ref = "nixos-20.03"; + rev = "afa9ca61924f05aacfe495a7ad0fd84709d236cc"; + }) {}; +in pkgs.mkShell { + buildInputs = with pkgs; [ + (haskellPackages.ghcWithPackages (hpkgs: with hpkgs; [ + hspec + optparse-applicative + unordered-containers + split + ])) + ]; +} -- cgit 1.4.1