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

3 files changed, 185 insertions, 0 deletions

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 ‘#’
+-}