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

6 files changed, 341 insertions, 0 deletions

diff --git a/challenge-075/jeongoon/.gitignore b/challenge-075/jeongoon/.gitignore
index a109a701fc..23c7e03022 100644
--- a/challenge-075/jeongoon/.gitignore
+++ b/challenge-075/jeongoon/.gitignore
@@ -1,3 +1,5 @@
 ch-1
 ch-2
 *~
+elm-stuff
+index.html
diff --git a/challenge-075/jeongoon/commmon-lisp/ch-1.lsp b/challenge-075/jeongoon/commmon-lisp/ch-1.lsp
new file mode 100644
index 0000000000..075e153215
--- /dev/null
+++ b/challenge-075/jeongoon/commmon-lisp/ch-1.lsp
@@ -0,0 +1,65 @@
+;; tested with:
+;; sbcl --script ch-1.lsp 6 1 2 4 # first one: sum; rest: coins
+;; ( sollution ... )
+(defun combi-coin-sum (coin-sum coin-list)
+  (if (null coin-list) nil
+    ;; else
+    (let*
+        ((sorted-coin-list (sort coin-list #'<))
+         (first-coin       (car sorted-coin-list))
+         (max-noc          (floor coin-sum first-coin))
+         (other-coins      (cdr sorted-coin-list))
+         (all-combi))
+      (loop for noc from max-noc downto 0
+            do
+            (let* ((small-change (- coin-sum (* first-coin noc))))
+              (if (= small-change 0)
+                  (let ((all-first-coins
+                         (make-list noc :initial-element first-coin)))
+                    (if (null all-combi) (setq all-combi (list all-first-coins))
+                      (nconc all-combi (list all-first-coins))))
+                ;; else
+                (let ((sub-combis (combi-coin-sum small-change other-coins)))
+                  (if (null sub-combis) nil
+                    ;; else
+                    (let ((head-combi
+                           (make-list noc :initial-element first-coin)))
+                      (map 'list
+                           #'(lambda (a-sub-combi)
+                               (let ((new-combi
+                                      (append head-combi a-sub-combi)))
+                                 (if (null all-combi)
+                                     (setq all-combi (list new-combi))
+                                   (nconc all-combi (list new-combi)))))
+                           sub-combis)))))))  ;; if sub-combis is nil,
+      (remove-if #'null all-combi))))        ;;    map will return nil
+
+;; ( testing ... )
+(defun get-command-line ()
+  (or
+   #+CLISP *args*
+   #+SBCL *posix-argv*
+   #+LISPWORKS system:*line-arguments-list*
+   #+CMU extensions:*command-line-words*
+   nil))
+
+(defparameter *cmdline* (get-command-line))
+
+(defun print-usage ()
+  (format t "Usage: sbcl --script ch-1.lsp <sum> <a coin list separated by space>"
+          (first *cmdline*)))
+
+(when (< (length *cmdline*) 3) (print-usage) (quit))
+
+(defparameter *coin-sum* (parse-integer (second *cmdline*)))
+(defparameter *coin-lst* (map 'list #'parse-integer (cddr *cmdline*)))
+(format t "Input:~%@C = ( ~{~d~^, ~} )~%" *coin-lst*)
+(format t "$S = ~d~%" *coin-sum*)
+
+(let ((total-combi (combi-coin-sum *coin-sum* *coin-lst*)))
+  (format t "Output: ~d~%~%" (length total-combi))
+  (format t "possible ways are:~%")
+  (map nil
+       #'(lambda (combi)
+           (progn
+             (format t "( ~{~d~^, ~} )~%" combi))) total-combi))
diff --git a/challenge-075/jeongoon/commmon-lisp/ch-2.lsp b/challenge-075/jeongoon/commmon-lisp/ch-2.lsp
new file mode 100644
index 0000000000..bd4626846c
--- /dev/null
+++ b/challenge-075/jeongoon/commmon-lisp/ch-2.lsp
@@ -0,0 +1,116 @@
+;; ( solution ... )
+;; which depends on combinations function
+(defun get-largest-rect-area (histogram-data)
+  (let*
+      ((histogram-size (length histogram-data))
+       (all-possible-area
+        (append
+         histogram-data ;; by size of width 1
+         (map 'list
+              #'(lambda (pos)
+                  (let* ((x1 (apply #'min pos)) ;; ensure x1 < x2
+                         (x2 (apply #'max pos))
+                         (common-height
+                          (apply #'min (subseq histogram-data x1 (1+ x2)))))
+                    (* common-height (1+ (- x2 x1)))))
+              (combinations-index 2 histogram-size)))))
+    (apply #'max all-possible-area)))
+
+;; ( bonus ... )
+(defun print-histogram (histogram-data)
+  (let* ((histogram-size (length histogram-data))
+         (max-height (apply #'max histogram-data))
+         (word-width (1+ (length (format nil "~d" max-height))))
+         (fmt-string (format nil "~~~d@a" word-width)))
+
+    (loop for y from max-height downto 1 collect
+          (let* ((line (format nil fmt-string y)) ;; first column: y scale
+                 )
+            ;; whitespace or sharpmark
+            (map nil
+                 #'(lambda (x-data)
+                     (let* ((current-word
+                             (format nil fmt-string
+                                     (if (< x-data y) "" "#"))))
+                       (setq line(concatenate 'string line current-word))))
+                 histogram-data)
+            (format t "~a~%" line)
+            line))
+    (format t "~a~%" (make-string (* word-width (1+ histogram-size))
+                                  :initial-element #\_))
+    (format t fmt-string "")
+    (map nil
+         #'(lambda (x-data) (format t fmt-string x-data)) histogram-data)
+    (format t "~%")))
+
+;; ( dependecies ... )
+(defun make-range (minv maxv &optional (step 1)) ;; from #072
+  (when (<= minv maxv)
+    (cons minv (make-range (+ minv step) maxv step))))
+
+(defun make-vector-range (min max &optional (step 1))
+  (let* ((range (make-range min max step))
+         (size (length range)))
+    (make-array (list size) :initial-contents range)))
+
+(defun combinations-index (n m) ;; translated from ch-2.pl
+  ;; a non-recursive method for making combinations
+  (when (>= m n)
+    (let* ((initial-room-size (- m n))
+           (room (make-array (list n) :initial-element initial-room-size))
+           (pos  (make-array (list n)
+                             :initial-contents (make-vector-range 0 (1- n))))
+           (next-cursor (1- n))
+           (combi (list (coerce pos 'list)))) ;; coerce makes a copy of array
+      (loop named moving-element do
+            (if (> (aref room next-cursor) 0)
+                ;; still current element move to right
+                (let ((ref-room (aref room next-cursor))
+                      (ref-pos  (aref pos  next-cursor)))
+                  (setf (aref room next-cursor) (1- ref-room))
+                  (setf (aref pos  next-cursor) (1+ ref-pos))
+                  (nconc combi (list (coerce pos 'list))))
+              ;; else
+              ;; no more room left on the right for current element
+              ;; have to move cursor to point next avaiable one.
+              (let*
+                  ((cursor-moved
+                    (loop named moving-cursor for i from next-cursor above 0
+                          do
+                          (when (> (aref room (1- i)) 0)
+                            (setq next-cursor (1- i))
+                            (return-from moving-cursor t)))))
+                (if cursor-moved
+                    (let ((room-size (1- (aref room next-cursor)))
+                          (base-pos  (aref pos next-cursor)))
+                      (loop for i from next-cursor below n
+                            for p from 1 do
+                            (progn
+                              (setf (aref room i) room-size)
+                              (setf (aref pos  i) (+ base-pos p))))
+                      (nconc combi (list (coerce pos 'list)))
+                      (setq next-cursor (1- n)))
+                  ;; else : "no more movement" means we found all combinations
+                  (return-from moving-element combi))))))))
+
+;; ( testing ... )
+(defun get-command-line ()
+  (or
+   #+CLISP *args*
+   #+SBCL *posix-argv*
+   #+LISPWORKS system:*line-arguments-list*
+   #+CMU extensions:*command-line-words*
+   nil))
+
+(defparameter *cmdline* (get-command-line))
+
+(defun print-usage ()
+  (format t "Usage: sbcl --script ch-2.lsp <at least one histogram data> ..."
+          (first *cmdline*)))
+
+(when (< (length *cmdline*) 2) (print-usage) (quit))
+
+(defparameter *histogram-data* (map 'list #'parse-integer (cdr *cmdline*)))
+(format t "Input: @A = ~A~%" *histogram-data*)
+(format t "Ouput: ~d~%" (get-largest-rect-area *histogram-data*))
+(print-histogram *histogram-data*)
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