Data commit

Task/Convert-seconds-to-compound-duration/Haskell/convert-seconds-to-compound-duration-1.hs

@@ -0,0 +1,28 @@
+import Control.Monad (forM_)
+import Data.List (intercalate, mapAccumR)
+import System.Environment (getArgs)
+import Text.Printf (printf)
+import Text.Read (readMaybe)
+
+reduceBy :: Integral a => a -> [a] -> [a]
+n `reduceBy` xs = n' : ys where (n', ys) = mapAccumR quotRem n xs
+
+-- Duration/label pairs.
+durLabs :: [(Integer, String)]
+durLabs = [(undefined, "wk"), (7, "d"), (24, "hr"), (60, "min"), (60, "sec")]
+
+-- Time broken down into non-zero durations and their labels.
+compdurs :: Integer -> [(Integer, String)]
+compdurs t = let ds = t `reduceBy` (map fst $ tail durLabs)
+             in filter ((/=0) . fst) $ zip ds (map snd durLabs)
+
+-- Compound duration of t seconds.  The argument is assumed to be positive.
+compoundDuration :: Integer -> String
+compoundDuration = intercalate ", " . map (uncurry $ printf "%d %s") . compdurs
+
+main :: IO ()
+main = do
+  args <- getArgs
+  forM_ args $ \arg -> case readMaybe arg of
+    Just n  -> printf "%7d seconds = %s\n" n (compoundDuration n)
+    Nothing -> putStrLn $ "Invalid number of seconds: " ++ arg

Task/Convert-seconds-to-compound-duration/Haskell/convert-seconds-to-compound-duration-2.hs

@@ -0,0 +1,71 @@
+import Data.List (intercalate, mapAccumR)
+
+---------------- COMPOUND DURATION STRINGS ---------------
+
+durationString ::
+  String ->
+  String ->
+  Int ->
+  Int ->
+  [String] ->
+  Int ->
+  String
+durationString
+  componentGap
+  numberLabelGap
+  daysPerWeek
+  hoursPerDay
+  xs
+  n =
+    intercalate
+      componentGap
+      ( foldr
+          (timeTags numberLabelGap)
+          []
+          (zip (weekParts daysPerWeek hoursPerDay n) xs)
+      )
+
+timeTags :: String -> (Int, String) -> [String] -> [String]
+timeTags numberLabelGap (n, s) xs
+  | 0 < n = intercalate numberLabelGap [show n, s] : xs
+  | otherwise = xs
+
+weekParts :: Int -> Int -> Int -> [Int]
+weekParts daysPerWeek hoursPerDay =
+  snd
+    . flip
+      (mapAccumR byUnits)
+      [0, daysPerWeek, hoursPerDay, 60, 60]
+
+byUnits :: Int -> Int -> (Int, Int)
+byUnits rest x = (quot (rest - m) u, m)
+  where
+    (u, m)
+      | 0 < x = (x, rem rest x)
+      | otherwise = (1, rest)
+
+--------------------------- TEST -------------------------
+
+translation :: String -> Int -> Int -> Int -> String
+translation local daysPerWeek hoursPerDay n =
+  intercalate "  ->  " $
+    [ show,
+      durationString
+        ", "
+        " "
+        daysPerWeek
+        hoursPerDay
+        (words local)
+    ]
+      <*> [n]
+
+main :: IO ()
+main = do
+  let names = "wk d hr min sec"
+  let tests = [7259, 86400, 6000000]
+
+  putStrLn "Assuming 24 hrs per day:"
+  mapM_ (putStrLn . translation names 7 24) tests
+
+  putStrLn "\nor, at 8 hours per day, 5 days per week:"
+  mapM_ (putStrLn . translation names 5 8) tests