Merge pull request #4604 from stuart-little/stuart-little_123_haskell

1st commit on 123_haskell

2 files changed, 33 insertions, 0 deletions

diff --git a/challenge-123/stuart-little/haskell/ch-1.hs b/challenge-123/stuart-little/haskell/ch-1.hs
new file mode 100755
index 0000000000..614550e161
--- /dev/null
+++ b/challenge-123/stuart-little/haskell/ch-1.hs
@@ -0,0 +1,13 @@
+#!/usr/bin/env runghc
+
+-- run as <script> <number $n> to return the first $n ugly numbers
+
+import System.Environment (getArgs,)
+import Data.List.Ordered (merge,nub,)
+
+smth = let primes=[2,3,5]
+  in nub (1:(foldl1 merge $ map (\x -> map (x*) $ nub $ smth) primes))
+
+main = do
+  (nr:_) <- getArgs
+  mapM_ putStrLn $ map show $ take (read nr::Int) $ smth
diff --git a/challenge-123/stuart-little/haskell/ch-2.hs b/challenge-123/stuart-little/haskell/ch-2.hs
new file mode 100755
index 0000000000..8590b95b16
--- /dev/null
+++ b/challenge-123/stuart-little/haskell/ch-2.hs
@@ -0,0 +1,20 @@
+#!/usr/bin/env runghc
+
+-- run <script> <x1 y1 x2 y2 ..>
+
+import Data.List (sort)
+import Data.List.Split (chunksOf)
+import System.Environment (getArgs)
+import Test.LeanCheck.Stats (counts)
+
+sqDist :: Num a => a -> a -> a -> a -> a
+sqDist x1 y1 x2 y2 = (x2-x1)*(x2-x1) + (y2-y1)*(y2-y1)
+
+sqDistHash :: (Eq a,Num a) => [a] -> [(a,Int)]
+sqDistHash xs = let pts = chunksOf 2 xs in counts $ [sqDist x1 y1 x2 y2 | [[x1,y1],[x2,y2]] <- sequence [pts,pts] ]
+
+isSq :: (Eq a,Num a) => [a] -> Bool
+isSq xs = (sort $ map snd $ sqDistHash xs) == [4,4,8]
+
+main :: IO ()
+main = getArgs >>= putStrLn . show . fromEnum . isSq . map (read::String->Double).(take 8)