[ch-074/jeongoon] Haskell, Common-lisp solution

5 files changed, 377 insertions, 0 deletions

diff --git a/challenge-074/jeongoon/common-lisp/ch-1.lsp b/challenge-074/jeongoon/common-lisp/ch-1.lsp
new file mode 100644
index 0000000000..c4c24fb8ab
--- /dev/null
+++ b/challenge-074/jeongoon/common-lisp/ch-1.lsp
@@ -0,0 +1,89 @@
+;; tested with:
+;; sbcl --script ch-1.lsp 10
+
+;; ( solution ... )
+(defun get-major (arr)
+  (let* ((sorted-copied (sort (copy-seq arr) #'<))
+         (result)
+         (len (length sorted-copied))
+         (half-len (floor (length sorted-copied) 2))
+         (prev-num (aref sorted-copied 0))
+         (prev-cnt 1))
+
+    (setq result
+          (loop named finding-major for i from 1 below len
+                do
+                (progn
+                  (if (= prev-num (aref sorted-copied i))
+                      (if (= prev-cnt half-len)
+                          (return-from finding-major (aref sorted-copied i))
+                        ;; else
+                        (setq prev-cnt (+ prev-cnt 1)))
+                      ;; else
+                      (progn (setq prev-num (aref sorted-copied i))
+                             (setq prev-cnt 1))))))
+
+    (if (null result) -1 result)))
+
+;; ( testing ... )
+(defun get-command-line () ;; from #072
+  (or
+   #+CLISP *args*
+   #+SBCL *posix-argv*
+   #+LISPWORKS system:*line-arguments-list*
+   #+CMU extensions:*command-line-words*
+   nil))
+
+(defun a-random (n)
+  (let ((*random-state* (make-random-state t)))
+    (random n)))
+
+(defun get-random-pairs (n)
+  (let ((*random-state* (make-random-state t)))
+       (loop for cnt from 1 to n
+             collect (list (random n) (random n)))))
+
+(defun shuffle-array-by-swapping (arr)
+  (let* ((size (length arr))
+         (shuffle-pairs (get-random-pairs size)))
+    (loop for pair in shuffle-pairs
+          do (let ((le (first pair)) (ri (second pair)))
+               (when (not (and (null le) (null ri)))
+                 ;; rotatef: change in place ; I think *f means put in pyhsical memory
+                 (rotatef (aref arr le) (aref arr ri)))))))
+
+(defparameter *cmdline* (get-command-line))
+
+(defun print-usage ()
+  (format t "Usage: sbcl --script ch-1.lsp <size-of-list>" (first *cmdline*)))
+
+(when (not (= (length *cmdline*) 2)) (print-usage) (quit))
+
+(defparameter *size* (parse-integer (second *cmdline*)))
+(defparameter *ensure-major*
+  (let ((*random-state* (make-random-state t))
+        (a-num (random *size*)))
+    (if (evenp a-num) t nil)))
+(defparameter *major-num*
+  (when *ensure-major* (a-random *size*)))
+
+(defparameter *sample* (make-array (list *size*)))
+;; generate *sample*
+(let* ((major-len (floor *size* 2))
+       (break-point 0))
+  (when *ensure-major*
+    (loop for i from 0 to major-len
+          do (setf (aref *sample* i) *major-num*))
+    (setq break-point major-len))
+  (loop for i from break-point below *size*
+        do (setf (aref *sample* i) (a-random *size*))))
+(shuffle-array-by-swapping *sample*) ;; note: change in place
+
+(format t "Input: ~S~%" *sample*)
+(defvar result (get-major *sample*))
+(format t "Output: ~d~%" result)
+
+;; Ref: http://clhs.lisp.se/Body/f_sort_.htm
+;;      https://www.tutorialspoint.com/lisp/lisp_arrays.htm
+;;      http://clhs.lisp.se/Body/f_random.htm
+;;      http://clhs.lisp.se/Body/f_cp_seq.htm
diff --git a/challenge-074/jeongoon/common-lisp/ch-2.lsp b/challenge-074/jeongoon/common-lisp/ch-2.lsp
new file mode 100644
index 0000000000..0122b94794
--- /dev/null
+++ b/challenge-074/jeongoon/common-lisp/ch-2.lsp
@@ -0,0 +1,103 @@
+;; 1. sort and delete-duplicates the copy of sequence
+;; 2. while traversing sublist of original data from the beginning
+;     a. reverse the sublist
+;;    b. find each chacter from the original datat twice (a)
+;;    c. if the chacter found only once (NR :Not Repeating)
+;;       make the pair of (character, length of right hand side result)
+;;    d. if the length is less than previous one, replace orginal data,
+;;       else leave it
+;; 3. if we have record return the the character, or return '#'
+
+;; tested with:
+;; sbcl --script ch-2.lsp xyzzyx
+
+;; ( solution ... )
+(defun get-lnr-string (str)
+  (coerce (get-lnr-char-list str) 'string))
+
+(defun get-lnr-char-list (str)
+  ;; 1.
+  (let* ((sorted-copied-uniq
+          ;; #'remove-duplicates -> make a *copy*
+          ;; #'sort              -> change applied *in place*
+          (sort (remove-duplicates str) #'char-lessp))
+          (str-len (length str)))
+
+    ;; 2.
+    (loop for i from 0 below str-len
+          ;; (subseq *seq* start-index &optional end-index) ;; end *exclusive*
+          collect (let* ((sub-len (+ i 1))
+                         (sub-str (subseq str 0 sub-len))
+                         (record '()))
+                    (loop for ch in (coerce sorted-copied-uniq 'list)
+                          do (let* ((ch-str (list ch)) ;; for #'search
+                                    (pos1 ;; first one found from the end
+                                     (search ch-str sub-str :from-end t)))
+                               (when (not (null pos1))
+                                 (let* ((pos2 ;; second one:
+                                         ;; the char already duplicated
+                                         (search ch-str sub-str
+                                                 :end2 pos1 :from-end t)))
+                                   (when (null pos2) ;; NR
+                                     (let ((rlength (- str-len pos1 1)))
+                                       (when (or (null record)
+                                                 (< rlength (cdr record)))
+                                         (setq record (cons ch-str rlength)))))))))
+                    ;; 3.
+                    (if (null record) #\# (caar record))))))
+
+;; ( 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 xueuxsnlejepkfx" (first *cmdline*)))
+
+(when (not (= (length *cmdline*) 2))
+  (format t "Wrong Number of arguments: expected 1: but got: ~d~%" (- (length *cmdline*) 1))
+  (print-usage)
+  (quit))
+
+(defparameter *sample-string* (string (second *cmdline*)))
+
+(format t "Input:  ~S~%" *sample-string*)
+(defvar fnr-string (get-lnr-string *sample-string*))
+(format t "Output: ~S~%" fnr-string)
+
+;; Ref: https://millsroboticsteam253.com/the-common-lisp-cookbook-data-structures/
+;; http://clhs.lisp.se/Body/f_subseq.htm
+;; http://clhs.lisp.se/Body/f_coerce.htm#coerce
+
+;; ----------------------------------------------------------------
+;; TASK #2 › FNR Character
+;; Submitted by: Mohammad S Anwar
+
+;; You are given a string $S.
+
+;; Write a script to print the series of first non-repeating character (left -> right) for the given string. Print # if none found.
+;; Example 1
+;; Input: $S = ‘ababc’
+;; Output: ‘abb#c’
+;; Pass 1: “a”, the FNR character is ‘a’
+;; Pass 2: “ab”, the FNR character is ‘b’
+;; Pass 3: “aba”, the FNR character is ‘b’
+;; Pass 4: “abab”, no FNR found, hence ‘#’
+;; Pass 5: “ababc” the FNR character is ‘c’
+
+;; Example 2
+;; Input: $S = ‘xyzzyx’
+;; Output: ‘xyzyx#’
+;; Pass 1: “x”, the FNR character is “x”
+;; Pass 2: “xy”, the FNR character is “y”
+;; Pass 3: “xyz”, the FNR character is “z”
+;; Pass 4: “xyzz”, the FNR character is “y”
+;; Pass 5: “xyzzy”, the FNR character is “x”
+;; Pass 6: “xyzzyx”, no FNR found, hence ‘#’
+;; ----------------------------------------------------------------
diff --git a/challenge-074/jeongoon/haskell/JRandomList.hs b/challenge-074/jeongoon/haskell/JRandomList.hs
new file mode 100644
index 0000000000..685e05a840
--- /dev/null
+++ b/challenge-074/jeongoon/haskell/JRandomList.hs
@@ -0,0 +1,49 @@
+module JRandomList
+  ( shuffleByPickingAll,
+  ) where
+
+import Data.List ( unfoldr, splitAt, tails )
+import System.Random ( randomR, Random, StdGen )
+import System.Environment (getArgs)
+
+
+{- Ref:
+https://www.schoolofhaskell.com/school/starting-with-haskell/libraries-and-frameworks/randoms
+https://hackage.haskell.org/package/containers-0.6.3.1/docs/Data-Sequence.html
+https://stackoverflow.com/questions/9834433/convert-data-sequence-to-a-list
+https://hackage.haskell.org/package/base-4.12.0.0/docs/Data-List.html
+https://en.wikibooks.org/wiki/Haskell/Libraries/Random
+https://hackage.haskell.org/package/optparse-generic-1.2.3/docs/Options-Generic.html
+-}
+
+descendingRandomR :: (Integral a, Ord a, Random a) =>
+                  ((a,   a), StdGen) -> Maybe (a, ((a, a), StdGen))
+descendingRandomR ((lo, hi), g) =
+  let (rv, g') = randomR (lo, hi) g -- rv: random value from seed(g)
+      hi' = hi - 1
+  in if lo > hi then Nothing else Just (rv, ((lo, hi'), g'))
+
+indicesToPick :: (Integral a, Random a) =>
+  a -> StdGen -> [a] -- input: <highest value> <seed>
+indicesToPick = (curry.curry $ unfoldr descendingRandomR) 0 -- 0: first index
+
+popAt :: Int -> [a] -> (Maybe a, [a])
+popAt = curry $ (\(le, ri) ->
+                    ( if null ri then Nothing else Just (head ri),
+                      le ++ tail ri ) ) . (uncurry splitAt)
+
+poping :: ([a], [Int]) -> Maybe (a, ([a], [Int]))
+poping ([], _) = Nothing
+poping (_, []) = Nothing
+poping (ls, idcs) =
+  let (e, ls') = popAt (head idcs) ls
+      idcs' = tail idcs
+  in case e of
+      Nothing  -> poping (ls', idcs') -- skip the index which is out of range
+      Just e'  -> Just (e', (ls', idcs'))
+
+shuffleByPickingAll :: [a] -> StdGen -> [a]
+shuffleByPickingAll ls seed = pick (ls, ( indicesToPick maxIdx seed ))
+  where
+    pick = unfoldr poping
+    maxIdx = ( length ls ) - 1
diff --git a/challenge-074/jeongoon/haskell/ch-1.hs b/challenge-074/jeongoon/haskell/ch-1.hs
new file mode 100644
index 0000000000..0dea499be8
--- /dev/null
+++ b/challenge-074/jeongoon/haskell/ch-1.hs
@@ -0,0 +1,79 @@
+{-# LANGUAGE DeriveGeneric     #-}
+{-# LANGUAGE OverloadedStrings #-}
+import Options.Generic
+import JRandomList
+import Data.List ( sort, unfoldr )
+
+import Data.Maybe
+import System.Random ( randoms, randomR, randomRs, newStdGen, StdGen )
+
+{- Tested with:
+runhaskell -i. ch-1.hs 10
+-}
+
+-- Solution
+getMajor []   = (-1)
+getMajor [x]  =  x
+getMajor list = case (last.processMajor.sort) list of
+                  Nothing  -> (-1)
+                  Just (x) ->   x
+  where
+    majlen = (length list) `div` 2
+    processMajor list@(l:ls) = unfoldr recordMajor ( ( l, 1), ls )
+    recordMajor ( (x, cnt), ls )
+      | null ls    = Nothing                                 -- edge case
+      | x == y     = if cnt == majlen
+                    then Just( Just x, ( (x ,succ cnt), [] ) ) -- major found
+                    else Just ( Nothing, ((x, succ cnt), ys) )
+      | otherwise = Just ( Nothing, ( (y, 1), ys ) )
+        where y = head ls; ys = tail ls;
+
+{- Comment: probably I could use `(filter f).group.sort' approach
+            but I still want to study more about haskell. -}
+
+-- Testing
+aSample size seed =
+  let majEnsured = head ( randoms seed :: [Bool] )
+      halfSize   = size `div` 2
+      lo = 0
+      hi = size -1
+      ( majNum, seed' ) = randomR ( lo, hi ) seed
+      majCnt  = fst $ if majEnsured then randomR ( halfSize+1, size-1 ) seed'
+                      else randomR ( 0, halfSize ) seed'
+      majList = replicate majCnt majNum
+      rstList = take (size - majCnt) (randomRs (lo, hi) seed)
+      majInfo = if majEnsured then Just ( majNum, majCnt ) else Nothing
+  in
+    ( majInfo, shuffleByPickingAll ( majList ++ rstList ) seed )
+
+validateSizeIO :: (Ord a, Show a) => a -> a -> IO a
+validateSizeIO def given = do
+  if given < def then
+    putStrLn ( "Given size is too short: " ++ (show given)
+               ++ ": using default size: " ++ (show def) )
+    >> return def
+    else putStrLn( "Given Size:" ++ (show given) )
+    >> return given
+
+main = do
+  args <- getRecord "Challenge #074 - Task #1"
+  let defS = 2
+      sStr = show ( args :: Int )
+      s = read sStr :: Int
+      getSize = validateSizeIO defS s in
+    do
+      size <- getSize;
+      seed <- newStdGen;
+      let ex = aSample size seed
+          majorInfoExist = isJust( fst ex )
+          majorNum   = (fst.fromJust) (fst ex)
+          solution = getMajor (snd ex)
+        in do
+        -- XXX: even though I didn't intend to make majority number
+        --      radom number list could have majority number
+        putStr $ "Input: " ++
+          (if majorInfoExist then "Major = " ++ show majorNum
+           else "*Maybe* No Major" ) ++ ": "
+        print $ snd ex
+        putStr   "Output: "
+        print $ solution
diff --git a/challenge-074/jeongoon/haskell/ch-2.hs b/challenge-074/jeongoon/haskell/ch-2.hs
new file mode 100644
index 0000000000..9eb3593795
--- /dev/null
+++ b/challenge-074/jeongoon/haskell/ch-2.hs
@@ -0,0 +1,57 @@
+{-# LANGUAGE DeriveGeneric     #-}
+{-# LANGUAGE OverloadedStrings #-}
+import Options.Generic
+import Data.List ( filter, find, group, sort, inits )
+import Data.Maybe
+
+{- Tested with:
+runhaskell -i. ch-2.hs "xyzzyx"
+-}
+
+-- Solution
+findLNR list = map curLNR $ (tail.inits) list
+  where
+    curLNR cs = case (lastOne cs) of Nothing  -> '#'
+                                     Just (c) ->  c
+    lastOne cs = find (`elem` candidates cs) (reverse cs)
+    {- *first* means unclear but examples show that we have to choose
+        *last* one appears only once
+        so I changed the name -}
+    candidates cs = ((map head).(filter onlyone).group.sort) cs
+      where onlyone x = length x == 1
+
+-- Testing
+main :: IO ()
+main = do
+  arg <- getRecord "Challenge #074 - Task #2"
+  putStrLn ( "Input: " ++ arg :: [Char] )
+  putStr "Output: "
+  print $ findLNR arg
+
+
+{-
+TASK #2 › FNR Character
+Submitted by: Mohammad S Anwar
+
+You are given a string $S.
+
+Write a script to print the series of first non-repeating character (left -> right) for the given string. Print # if none found.
+Example 1
+Input: $S = ‘ababc’
+Output: ‘abb#c’
+Pass 1: “a”, the FNR character is ‘a’
+Pass 2: “ab”, the FNR character is ‘b’
+Pass 3: “aba”, the FNR character is ‘b’
+Pass 4: “abab”, no FNR found, hence ‘#’
+Pass 5: “ababc” the FNR character is ‘c’
+
+Example 2
+Input: $S = ‘xyzzyx’
+Output: ‘xyzyx#’
+Pass 1: “x”, the FNR character is “x”
+Pass 2: “xy”, the FNR character is “y”
+Pass 3: “xyz”, the FNR character is “z”
+Pass 4: “xyzz”, the FNR character is “y”
+Pass 5: “xyzzy”, the FNR character is “x”
+Pass 6: “xyzzyx”, no FNR found, hence ‘#’
+-}