diff options
-rwxr-xr-x | shelf.hs | 60 |
1 files changed, 42 insertions, 18 deletions
@@ -3,6 +3,7 @@ | |||
3 | --ghc-options -Wall --ghc-options -Wno-unused-imports --ghc-options -Wno-name-shadowing -} | 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 | {-# language RecordWildCards #-} | ||
6 | import Rebase.Prelude | 7 | import Rebase.Prelude |
7 | import Control.Lens | 8 | import Control.Lens |
8 | 9 | ||
@@ -30,28 +31,51 @@ formatFeet l = unwords $ toList (feet f) ++ toList (inches i n d) | |||
30 | 31 | ||
31 | type Inches = Rational | 32 | type Inches = Rational |
32 | 33 | ||
33 | boardLength, boardThickness, kickerHeight, availableSpace :: Inches | 34 | data Shelf = Shelf { |
34 | boardLength = 6 * 12 | 35 | boardLength :: Inches, |
35 | boardThickness = 5/8 | 36 | boardThickness :: Inches, |
36 | kickerHeight = 4 + 1/2 | 37 | kickerHeight :: Inches, |
37 | numHorizontals, numShelves :: Int | 38 | shelves :: [Integer] |
38 | numShelves = length shelves | 39 | } |
39 | 40 | ||
40 | numHorizontals = numShelves + 1 | 41 | bookshelf :: Shelf |
41 | availableSpace = boardLength - kickerHeight - (toRational numHorizontals) * boardThickness | 42 | bookshelf = Shelf { |
43 | boardLength = 6 * 12, | ||
44 | boardThickness = 5/8, | ||
45 | kickerHeight = 4 + 1/2, | ||
46 | shelves = [4, 4, 4, 3, 3] | ||
47 | } | ||
42 | 48 | ||
43 | shelves :: [Inches] | 49 | pianoCubbies :: Shelf |
44 | shelves = map (* availableSpace) $ map (% 18) [4, 4, 4, 3, 3] | 50 | pianoCubbies = Shelf { |
51 | boardLength = 52 + 1%8, | ||
52 | boardThickness = 5/8, | ||
53 | kickerHeight = 0, | ||
54 | shelves = [1, 1, 1, 1] | ||
55 | } | ||
45 | 56 | ||
46 | positions, positions' :: [Inches] | 57 | positions, positions' :: Shelf -> [Inches] |
47 | positions = map sum $ (tail . inits) $ concatMap (: [boardThickness]) $ kickerHeight : shelves | 58 | positions Shelf{..} = map sum $ (tail . inits) $ concatMap (: [boardThickness]) $ kickerHeight : shelvesAbs |
59 | where | ||
60 | shelvesAbs = map (* availableSpace) shelves' | ||
61 | shelves' = map (% (sum shelves)) shelves | ||
62 | numHorizontals, numShelves :: Int | ||
63 | numShelves = length shelves | ||
64 | numHorizontals = numShelves + 1 | ||
65 | availableSpace = boardLength - kickerHeight - (toRational numHorizontals) * boardThickness | ||
66 | |||
67 | positions' x@Shelf{..} = map (boardLength -) $ positions x | ||
48 | 68 | ||
49 | positions' = map (boardLength -) positions | 69 | printPositions :: Shelf -> IO () |
70 | printPositions x = do | ||
71 | mapM_ putStrLn $ formatFeet <$> positions x | ||
72 | when (positions x /= reverse (positions' x)) $ do | ||
73 | putStrLn "\nReversed:\n" | ||
74 | mapM_ putStrLn $ formatFeet <$> positions' x | ||
50 | 75 | ||
51 | main :: IO () | 76 | main :: IO () |
52 | main = do | 77 | main = do |
53 | -- assert $ sum shelves == 1 | 78 | putStrLn "Piano cubbies:\n" |
54 | mapM_ putStrLn $ formatFeet <$> positions | 79 | printPositions pianoCubbies |
55 | putStrLn "" | 80 | putStrLn "\n\nBookshelf:\n" |
56 | mapM_ putStrLn $ formatFeet <$> positions' | 81 | printPositions bookshelf |
57 | return () | ||