diff options
author | Andrew Cady <d@jerkface.net> | 2020-12-29 14:56:54 -0500 |
---|---|---|
committer | Andrew Cady <d@jerkface.net> | 2020-12-29 14:56:54 -0500 |
commit | 3b57f59955968a3c3288ba3e8fb79114b78bc370 (patch) | |
tree | 6068fa8878b8c4ae3fca7f64afa615b36e9c5af0 | |
parent | ab981deb57eedc35ec7bbb4f20e9deecd307123c (diff) |
fixed
-rwxr-xr-x | shelf.hs | 61 |
1 files changed, 30 insertions, 31 deletions
@@ -1,6 +1,6 @@ | |||
1 | #!/usr/bin/env stack | 1 | #!/usr/bin/env stack |
2 | {- stack script --resolver lts-16.27 --install-ghc | 2 | {- stack script --resolver lts-16.27 --install-ghc |
3 | --ghc-options -Wall --ghc-options -Wno-unused-imports -} | 3 | --ghc-options -Wall --ghc-options -Wno-unused-imports --ghc-options -Wno-name-shadowing -} |
4 | {-# language NoImplicitPrelude #-} | 4 | {-# language NoImplicitPrelude #-} |
5 | {-# language DuplicateRecordFields #-} | 5 | {-# language DuplicateRecordFields #-} |
6 | import Rebase.Prelude | 6 | import Rebase.Prelude |
@@ -9,50 +9,49 @@ import Control.Lens | |||
9 | import Data.Ratio | 9 | import Data.Ratio |
10 | import Text.Printf | 10 | import Text.Printf |
11 | 11 | ||
12 | toCarpenter :: RealFrac a => a -> (Int, Int, Ratio Int) | 12 | formatFeet :: RealFrac a => a -> String |
13 | toCarpenter l = (feet, div r 32, mod r 32 % 32) where | 13 | formatFeet 0 = "0" |
14 | (feet, r) = divMod (round $ l * 32) (32 * 12) | 14 | formatFeet l = unwords $ toList (feet f) ++ toList (inches i n d) |
15 | 15 | where | |
16 | feetAndInches :: RealFrac a => a -> String | 16 | feet 0 = Nothing |
17 | feetAndInches l = case toCarpenter l of | 17 | feet f = Just $ printf "%d'" f |
18 | (0,0,0) -> "0 feet 0 inches" | 18 | inches 0 0 _ = Nothing |
19 | (f,i,t) -> showUnit "foot" "feet" (f % 1) ++ | 19 | inches i 0 _ = Just $ printf "%d\"" i |
20 | (if f > 0 && (i%1 + t) > 0 then " " else "") ++ | 20 | inches 0 n d = Just $ printf "%d/%d\"" n d |
21 | showUnit "inch" "inches" (i % 1 + t) | 21 | inches i n d = Just $ printf "%d %d/%d\"" i n d |
22 | where | 22 | |
23 | showUnit _ _ 0 = "" | 23 | n = numerator t |
24 | showUnit s m n = printf "%s %s" (showVal n) $ if n <= 1 then s else m | 24 | d = denominator t |
25 | showVal v | d == 1 = show n | 25 | (f, i, t) = toCarpenter l |
26 | | v < 1 = printf "%d/%d" n d | 26 | |
27 | | otherwise = printf "%d and %d/%d" (div n d) (mod n d) d | 27 | toCarpenter :: RealFrac a => a -> (Int, Int, Ratio Int) |
28 | where (n,d) = (numerator v, denominator v) | 28 | toCarpenter l = (feet, div r 32, mod r 32 % 32) where |
29 | (feet, r) = divMod (round $ l * 32) (32 * 12) | ||
29 | 30 | ||
30 | type Inches = Rational | 31 | type Inches = Rational |
31 | 32 | ||
32 | boardLength, boardThickness, kickerHeight, numShelves, numHorizontals, availableSpace :: Inches | 33 | boardLength, boardThickness, kickerHeight, availableSpace :: Inches |
33 | boardLength = 6 * 12 | 34 | boardLength = 6 * 12 |
34 | boardThickness = 5/8 | 35 | boardThickness = 5/8 |
35 | kickerHeight = 4 | 36 | kickerHeight = 4 |
36 | numShelves = 5 | 37 | numHorizontals, numShelves :: Int |
38 | numShelves = length shelves | ||
37 | 39 | ||
38 | numHorizontals = numShelves + 1 | 40 | numHorizontals = numShelves + 1 |
39 | availableSpace = boardLength - kickerHeight - numHorizontals * boardThickness | 41 | availableSpace = boardLength - kickerHeight - (toRational numHorizontals) * boardThickness |
40 | 42 | ||
41 | shelves :: [Rational] | 43 | shelves :: [Rational] |
42 | shelves = kickerHeight : map (* availableSpace) [2%9, 2%9, 2%9, 1%6, 1%6] | 44 | shelves = map (* availableSpace) [2%9, 2%9, 2%9, 1%6, 1%6] |
43 | 45 | ||
44 | positions :: [Inches] | 46 | positions, positions' :: [Inches] |
45 | positions = map (+ boardThickness) $ map sum $ tails shelves | 47 | positions = map sum $ (tail . inits) $ concatMap (: [boardThickness]) $ kickerHeight : shelves |
46 | 48 | ||
47 | positions' = map (boardLength -) positions | 49 | positions' = map (boardLength -) positions |
48 | 50 | ||
49 | main :: IO () | 51 | main :: IO () |
50 | main = do | 52 | main = do |
51 | _ <- return $ assert $ sum shelves == 1 | 53 | void $ return $ assert $ sum shelves == 1 |
52 | print shelves | 54 | mapM_ putStrLn $ formatFeet <$> positions |
53 | print positions | 55 | putStrLn "" |
54 | print $ map (fromRational :: Rational -> Float) positions | 56 | mapM_ putStrLn $ formatFeet <$> positions' |
55 | print positions' | ||
56 | print $ map (fromRational :: Rational -> Float) positions' | ||
57 | mapM_ putStrLn $ feetAndInches <$> positions' | ||
58 | return () | 57 | return () |