Data commit

Task/Longest-increasing-subsequence/Haskell/longest-increasing-subsequence-1.hs

@@ -0,0 +1,12 @@
+import Data.Ord          ( comparing )
+import Data.List         ( maximumBy, subsequences )
+import Data.List.Ordered ( isSorted, nub )
+
+lis :: Ord a => [a] -> [a]
+lis = maximumBy (comparing length) . map nub  . filter isSorted . subsequences
+--    longest                    <-- unique <-- increasing    <-- all
+
+main = do
+  print $ lis [3,2,6,4,5,1]
+  print $ lis [0,8,4,12,2,10,6,14,1,9,5,13,3,11,7,15]
+  print $ lis [1,1,1,1]

Task/Longest-increasing-subsequence/Haskell/longest-increasing-subsequence-2.hs

@@ -0,0 +1,52 @@
+{-# LANGUAGE FlexibleContexts, UnicodeSyntax #-}
+
+module Main (main, lis) where
+
+import Control.Monad.ST  ( ST, runST )
+import Control.Monad     ( (>>=), (=<<), foldM )
+import Data.Array.ST     ( Ix,  STArray, readArray, writeArray, newArray )
+import Data.Array.MArray ( MArray )
+
+infix 4 ≡
+
+(≡) :: Eq α ⇒ α → α → Bool
+(≡) = (==)
+
+(∘) = (.)
+
+
+lis ∷ Ord α ⇒ [α] → [α]
+lis xs = runST $ do
+  let lxs = length xs
+  pileTops ← newSTArray (min 1 lxs , lxs) []
+  i        ← foldM (stack pileTops) 0 xs
+  readArray pileTops i >>= return ∘ reverse
+
+stack ∷ (Integral ι, Ord ε, Ix ι, MArray α [ε] μ)
+      ⇒ α ι [ε] → ι → ε → μ ι
+stack piles i x = do
+  j ← bsearch piles x i
+  writeArray piles j ∘ (x:) =<< if j ≡ 1 then return []
+                                         else readArray piles (j-1)
+  return $ if j ≡ i+1 then i+1 else i
+
+bsearch ∷ (Integral ι, Ord ε, Ix ι, MArray α [ε] μ)
+        ⇒ α ι [ε] → ε → ι → μ ι
+bsearch piles x = go 1
+  where go lo hi | lo > hi   = return lo
+                 | otherwise =
+                    do (y:_) ← readArray piles mid
+                       if y < x then go (succ mid) hi
+                                else go lo (pred mid)
+
+                         where mid = (lo + hi) `div` 2
+
+newSTArray ∷ Ix ι ⇒ (ι,ι) → ε → ST σ (STArray σ ι ε)
+newSTArray = newArray
+
+
+main ∷ IO ()
+main = do
+  print $ lis [3, 2, 6, 4, 5, 1]
+  print $ lis [0, 8, 4, 12, 2, 10, 6, 14, 1, 9, 5, 13, 3, 11, 7, 15]
+  print $ lis [1, 1, 1, 1]