[ch-075/jeongoon] add Haskell and Common-lisp solution with bonus

3 files changed, 158 insertions, 0 deletions

diff --git a/challenge-075/jeongoon/haskell/JCombinations.hs b/challenge-075/jeongoon/haskell/JCombinations.hs
new file mode 100644
index 0000000000..07456e689c
--- /dev/null
+++ b/challenge-075/jeongoon/haskell/JCombinations.hs
@@ -0,0 +1,45 @@
+module JCombinations
+  ( combinationsIndex
+  ) where
+
+combinationsIndex :: Int -> Int -> [[Int]]
+combinationsIndex n m -- return always sorted members and sorted list
+  | m < n = []
+  | otherwise =
+    --       acc         room               nextId to move
+    impli [[0 .. (n-1)]] (replicate n (m-n)) (n-1)
+    where
+      incrAt idx list = take idx list
+                        ++ ((list !! idx) +1) : drop (idx+1) list
+      dcrAt idx list  = take idx list
+                        ++ ((list !! idx) -1) : drop (idx+1) list
+      impli acc roomLs nextCsr =
+        if roomLs !! nextCsr > 0 -- still current cursor is movable
+        then impli (acc ++ [newPosLs]) (dcrAt nextCsr roomLs) nextCsr
+        else -- no more room to move
+          -- find the next element available to move
+          case (pointNextCsr nextCsr) of
+            Nothing    -> acc  -- if we cannot move any of them which means
+                              -- we found all cases.
+            Just newCsr ->     -- move all cursors
+                              -- and try to move last cursor next time
+              impli ( acc ++ [updatePosLsFrom newCsr] )
+                    (updateRoomFrom newCsr) (n-1)
+          where
+            posLs    = last acc
+            newPosLs = (incrAt nextCsr posLs)
+
+            updatePosLsFrom fromCsr = -- move all cursors
+              take (fromCsr) posLs    -- keep until fromCsr
+              -- and reset others to leftmost part of the elements
+              ++ take (n -fromCsr) [ ((posLs !! fromCsr)+1) .. ]
+            updateRoomFrom fromCsr =
+              take (fromCsr) roomLs
+              -- reduce each room by one
+              ++ replicate (n -fromCsr) ((roomLs !! fromCsr) -1)
+
+            pointNextCsr curcsr
+              | curcsr == 0 = Nothing
+              | otherwise  = if roomLs !! nxtcsr > 0 then Just nxtcsr
+                             else pointNextCsr nxtcsr
+              where nxtcsr = curcsr - 1
diff --git a/challenge-075/jeongoon/haskell/ch-1.hs b/challenge-075/jeongoon/haskell/ch-1.hs
new file mode 100644
index 0000000000..ff4b6f036b
--- /dev/null
+++ b/challenge-075/jeongoon/haskell/ch-1.hs
@@ -0,0 +1,60 @@
+{-# LANGUAGE DeriveGeneric     #-}
+{-# LANGUAGE OverloadedStrings #-}
+import Options.Generic
+import Data.List (sortBy, unfoldr)
+import Data.Maybe (fromJust, isJust)
+
+{- Tested with:
+runhaskell ch-1.hs --coinsum=6 --c=1 --c=2 --c=4
+-}
+
+-- solution
+totalNumberOfCombinations = length.combiCoinSum
+combiCoinSum ( targetSum, coins ) =
+  case ( combCS targetSum coins ) of
+    Nothing -> []
+    Just xs -> xs
+  where
+    combCS :: Int -> [Int] -> Maybe [[Int]]
+    combCS targetSum coins
+      | null coins = Nothing
+      | otherwise  = Just $ (joinCombi.grepCombi) goThroughThisCoin
+      where
+        thisCoin        = head sortedCoinsDesc
+        otherCoins      = tail sortedCoinsDesc
+        sortedCoinsDesc = sortBy (\a b -> compare b a) coins
+        maxNoc          = targetSum `div` thisCoin -- Noc : Number Of Coins
+        joinCombi       = foldr (++) []
+        grepCombi       = (map fromJust).(filter isJust)
+
+        goThroughThisCoin = unfoldr goThroughThisCoinInner maxNoc
+        goThroughThisCoinInner noc
+          | noc < 0 = Nothing
+          | otherwise =
+            if smallChange == 0 then -- generate from nocMax to 0
+              Just ( Just [fillThisCoin], (pred noc) )
+            else case (combCS smallChange otherCoins) of
+                Nothing -> Just ( Nothing, (pred noc) )
+                Just  p -> Just ( Just (
+                                   map (\r -> fillThisCoin ++ r) p), (pred noc))
+          where
+            fillThisCoin = (replicate noc thisCoin)
+            smallChange  = targetSum - ( thisCoin * noc )
+
+data Sample = Sample { coinsum :: Int, c :: [Int] }
+  deriving (Generic, Show)
+instance ParseRecord Sample
+
+-- testing
+main = do
+  args <- getRecord "Challennge #076 - Task #1"
+  let sample = args :: Sample
+      sSum   = coinsum sample
+      sCoins = c       sample in
+    do
+      putStrLn "Input:"
+      putStrLn $ "@C = "   ++ (show sCoins)
+      putStrLn $ "$S = "   ++ (show sSum)
+      putStrLn $ "Output:" ++ (show (totalNumberOfCombinations(sSum, sCoins)))
+      putStrLn $ "possible ways are: "
+      mapM_ (putStrLn.show) (combiCoinSum(sSum, sCoins))
diff --git a/challenge-075/jeongoon/haskell/ch-2.hs b/challenge-075/jeongoon/haskell/ch-2.hs
new file mode 100644
index 0000000000..482bbf3175
--- /dev/null
+++ b/challenge-075/jeongoon/haskell/ch-2.hs
@@ -0,0 +1,53 @@
+{-# LANGUAGE DeriveGeneric     #-}
+{-# LANGUAGE OverloadedStrings #-}
+import Options.Generic
+import JCombinations (combinationsIndex)
+import Data.List (unfoldr)
+import System.Exit (die)
+
+-- solution
+
+getLargestRectArea :: [Int] -> Int
+getLargestRectArea hdata = maximum allPossibleAreas where
+  allPossibleAreas =  map calcArea1 [ 0 .. (dataLen - 1) ]
+                      ++ map calcArea2 (combinationsIndex 2 dataLen)
+    where
+      dataLen   = length hdata
+      calcArea1 = (hdata !!)
+      calcArea2 = (\xs -> (commonH xs) * ((last xs)-(head xs)+1))
+      commonH xs = (minimum.map (hdata !!)) [ (head xs) .. (last xs) ]
+
+-- bonus
+printHistogram :: [Int] -> IO ()
+printHistogram hdata = do
+  mapM_ putStrLn lineBuffers where
+    hdataLen    = length hdata
+    maxH        = maximum hdata
+    lineBuffers = unfoldr forYaxis maxH
+    forYaxis (y)
+      | y ==  0   = Just( replicate (wordWidth * (hdataLen +1)) '_',  y-1 )
+      | y == -1   = Just( whiteSpace
+                         ++ (foldl (\acc x ->
+                                   acc ++ (fixedNumber x)) "" hdata) , y-1 )
+      | y < -1   = Nothing
+      | otherwise = Just( yScale ++ allColumnData, y-1 )
+      where
+        wordWidth  = ((length.show) maxH) +1
+        whiteSpace = replicate wordWidth ' '
+        yScale     = fixedNumber y
+        fixedNumber   n = (preWhiteSpace n) ++ (show n)
+        sharpMark       = (replicate (wordWidth - 1) ' ') ++ ['#']
+        preWhiteSpace n = replicate (wordWidth - (length (show n))) ' '
+        allColumnData   =
+          foldl (\acc x -> acc ++ (if x < y
+                               then whiteSpace else sharpMark )) "" hdata
+
+-- testing
+main = do
+  args <- getRecord "Challenge #075 - Task #2"
+  let sample = args::[Int] in do
+    if null sample then die "list not given: runhaskell ch-2.hs <list ...>"
+      else return ()
+    putStrLn ("Input: "  ++ (show sample))
+    putStrLn ("Output: " ++ (show (getLargestRectArea sample)))
+    printHistogram sample