From a9abc1da41b56edbed00081800382e854d6698d0 Mon Sep 17 00:00:00 2001 From: Joe Zhao Date: Tue, 31 Mar 2015 23:41:55 +0800 Subject: rename to H**, +31 +32 +33 +34 +35 +36 --- H1.hs | 9 +++++++++ H10.hs | 24 ++++++++++++++++++++++++ H11.hs | 15 +++++++++++++++ H12.hs | 8 ++++++++ H13.hs | 15 +++++++++++++++ H14.hs | 10 ++++++++++ H15.hs | 11 +++++++++++ H16.hs | 2 ++ H17.hs | 10 ++++++++++ H18.hs | 7 +++++++ H19.hs | 6 ++++++ H2.hs | 11 +++++++++++ H20.hs | 7 +++++++ H21.hs | 2 ++ H22.hs | 8 ++++++++ H23.hs | 21 +++++++++++++++++++++ H24.hs | 7 +++++++ H25.hs | 8 ++++++++ H26.hs | 5 +++++ H27.hs | 13 +++++++++++++ H28.hs | 11 +++++++++++ H28n.hs | 14 ++++++++++++++ H3.hs | 7 +++++++ H31.hs | 15 +++++++++++++++ H32.hs | 3 +++ H33.hs | 3 +++ H34.hs | 3 +++ H35.hs | 21 +++++++++++++++++++++ H36.hs | 4 ++++ H4.hs | 3 +++ H5.hs | 3 +++ H6.hs | 11 +++++++++++ H7.hs | 5 +++++ H8.hs | 12 ++++++++++++ H9.hs | 13 +++++++++++++ h1.hs | 9 --------- h10.hs | 20 -------------------- h11.hs | 15 --------------- h12.hs | 8 -------- h13.hs | 15 --------------- h14.hs | 10 ---------- h15.hs | 11 ----------- h16.hs | 2 -- h17.hs | 10 ---------- h18.hs | 7 ------- h19.hs | 6 ------ h2.hs | 11 ----------- h20.hs | 7 ------- h21.hs | 2 -- h22.hs | 8 -------- h23.hs | 21 --------------------- h24.hs | 7 ------- h25.hs | 8 -------- h26.hs | 5 ----- h27.hs | 13 ------------- h28.hs | 11 ----------- h28n.hs | 14 -------------- h3.hs | 7 ------- h4.hs | 3 --- h5.hs | 3 --- h6.hs | 11 ----------- h7.hs | 5 ----- h8.hs | 12 ------------ h9.hs | 13 ------------- 64 files changed, 327 insertions(+), 274 deletions(-) create mode 100644 H1.hs create mode 100644 H10.hs create mode 100644 H11.hs create mode 100644 H12.hs create mode 100644 H13.hs create mode 100644 H14.hs create mode 100644 H15.hs create mode 100644 H16.hs create mode 100644 H17.hs create mode 100644 H18.hs create mode 100644 H19.hs create mode 100644 H2.hs create mode 100644 H20.hs create mode 100644 H21.hs create mode 100644 H22.hs create mode 100644 H23.hs create mode 100644 H24.hs create mode 100644 H25.hs create mode 100644 H26.hs create mode 100644 H27.hs create mode 100644 H28.hs create mode 100644 H28n.hs create mode 100644 H3.hs create mode 100644 H31.hs create mode 100644 H32.hs create mode 100644 H33.hs create mode 100644 H34.hs create mode 100644 H35.hs create mode 100644 H36.hs create mode 100644 H4.hs create mode 100644 H5.hs create mode 100644 H6.hs create mode 100644 H7.hs create mode 100644 H8.hs create mode 100644 H9.hs delete mode 100644 h1.hs delete mode 100644 h10.hs delete mode 100644 h11.hs delete mode 100644 h12.hs delete mode 100644 h13.hs delete mode 100644 h14.hs delete mode 100644 h15.hs delete mode 100644 h16.hs delete mode 100644 h17.hs delete mode 100644 h18.hs delete mode 100644 h19.hs delete mode 100644 h2.hs delete mode 100644 h20.hs delete mode 100644 h21.hs delete mode 100644 h22.hs delete mode 100644 h23.hs delete mode 100644 h24.hs delete mode 100644 h25.hs delete mode 100644 h26.hs delete mode 100644 h27.hs delete mode 100644 h28.hs delete mode 100644 h28n.hs delete mode 100644 h3.hs delete mode 100644 h4.hs delete mode 100644 h5.hs delete mode 100644 h6.hs delete mode 100644 h7.hs delete mode 100644 h8.hs delete mode 100644 h9.hs diff --git a/H1.hs b/H1.hs new file mode 100644 index 0000000..f0216c2 --- /dev/null +++ b/H1.hs @@ -0,0 +1,9 @@ + +myLast :: [a] -> a +myLast [] = error "Empty List" +myLast [x] = x +myLast (x:xs) = myLast xs + +myLast' = foldl1 (flip const) + +myLast'' = foldl1 (curry snd) diff --git a/H10.hs b/H10.hs new file mode 100644 index 0000000..0694b69 --- /dev/null +++ b/H10.hs @@ -0,0 +1,24 @@ +module H10 +( encode +) where + +import Control.Applicative +import Control.Arrow +import Data.List + +encode :: Eq a => [a] -> [(a,Int)] +encode = foldr elim [] + where + elim e [] = [(e,1)] + elim e p@(n:ns) + | e == fst n = (e,1 + (snd n)):ns + | otherwise = (e,1):p + +encode' (x:xs) = let (first,rest) = span (==x) xs + in (x,1+(length first)) : encode' rest + +encode' [] = [] + +encode'' xs = map (head &&& length) $ group xs + +encode''' xs = map ((,) <$> head <*> length) $ group xs diff --git a/H11.hs b/H11.hs new file mode 100644 index 0000000..77b7295 --- /dev/null +++ b/H11.hs @@ -0,0 +1,15 @@ +import Control.Arrow +import Data.List + +data ListItem a = Single a | Multiple a Int + deriving (Show) + +encode :: Eq a => [a] -> [(a,Int)] +encode xs = map (head &&& length) $ group xs + +encodeModified :: Eq a => [a] -> [ListItem a] +encodeModified = map helper . encode + where + helper (a,1) = Single a + helper (a,c) = Multiple a c + diff --git a/H12.hs b/H12.hs new file mode 100644 index 0000000..9b1b50e --- /dev/null +++ b/H12.hs @@ -0,0 +1,8 @@ +data ListItem a = Single a | Multiple a Int + deriving (Show) + +decodeModified :: [ListItem a] -> [a] +decodeModified = concatMap decodeHelper + where + decodeHelper (Single a) = [a] + decodeHelper (Multiple a b) = replicate b a diff --git a/H13.hs b/H13.hs new file mode 100644 index 0000000..ec0a395 --- /dev/null +++ b/H13.hs @@ -0,0 +1,15 @@ +data ListItem a = Single a | Multiple a Int + deriving (Show) + +encode :: Eq a => [a] -> [(a,Int)] +encode = foldr encodeHelper [] + where + encodeHelper a p@((x,c):ps) | x==a = (a,c+1):ps + encodeHelper a p = (a,1):p + +encodeDirect :: Eq a => [a] -> [ListItem a] +encodeDirect = map encodeHelper . encode + where + encodeHelper (a,c) + | c>1 = Multiple a c + | otherwise = Single a diff --git a/H14.hs b/H14.hs new file mode 100644 index 0000000..e7ad73d --- /dev/null +++ b/H14.hs @@ -0,0 +1,10 @@ +import Control.Applicative + +dupli :: [a] -> [a] +dupli = concatMap (replicate 2) + +dupli' xs = concat [ [x,x] | x <- xs ] + +dupli'' = (<**> [id,id]) + +dupli''' = foldr ((.) <$> (:) <*> (:)) [] diff --git a/H15.hs b/H15.hs new file mode 100644 index 0000000..a8f84c1 --- /dev/null +++ b/H15.hs @@ -0,0 +1,11 @@ +import Control.Monad + +repli :: [a] -> [a] +repli xs n = concatMap (replicate n) xs + +repli' = flip $ concatMap . replicate + +repli'' xs n = xs >>= replicate n + +repli''' [] _ = [] +repli''' (x:xs) n = foldr (const (x:)) (repli xs n) [1..n] diff --git a/H16.hs b/H16.hs new file mode 100644 index 0000000..68978a7 --- /dev/null +++ b/H16.hs @@ -0,0 +1,2 @@ +dropEvery :: [a] -> Int -> [a] +dropEvery xs c = [x| (x,y) <- (zip xs [1..]), y `mod` c /= 0 ] diff --git a/H17.hs b/H17.hs new file mode 100644 index 0000000..fa26f35 --- /dev/null +++ b/H17.hs @@ -0,0 +1,10 @@ +split :: [a] -> Int -> ([a],[a]) +split xs c = splitHelper [] xs c + where + splitHelper pre nxt 0 = (reverse pre, nxt) + splitHelper pre (x:nxt) c = splitHelper (x:pre) nxt (c-1) + +split' (x:xs) c | c>0 = + let (pre,nxt) = split' xs (c-1) + in (x:pre,nxt) +split' xs _ = ([],xs) diff --git a/H18.hs b/H18.hs new file mode 100644 index 0000000..b9e8192 --- /dev/null +++ b/H18.hs @@ -0,0 +1,7 @@ +slice :: [a] -> Int -> Int -> [a] +slice (x:xs) a b + | a > 1 = slice xs (a-1) (b-1) + | a <= 1 && b >= 1 = x:(slice xs (a-1) (b-1)) + | otherwise = [] + +slice' xs i j = [x | (x,k)<- (zip xs [1..j]) , k >= i] diff --git a/H19.hs b/H19.hs new file mode 100644 index 0000000..45c5a07 --- /dev/null +++ b/H19.hs @@ -0,0 +1,6 @@ +rotate :: [a] -> Int -> [a] +rotate xs c + | c < 0 = rotate xs (c + (length xs)) + | otherwise = (drop (c `mod` (length xs)) xs ) ++ (take (c `mod` (length xs)) xs) + +rotate' xs c = take (length xs) $ drop (length xs + c) $ cycle xs diff --git a/H2.hs b/H2.hs new file mode 100644 index 0000000..60693ef --- /dev/null +++ b/H2.hs @@ -0,0 +1,11 @@ +import Data.Foldable as F + +myButLast :: Foldable f => f a -> a + +myButLast = fst . F.foldl (\(a,b) x -> (b,x)) (err1, err2) + where + err1 = error "Empty list" + err2 = error "Not enough elements" + +mySafeButLast :: Foldable f => f a -> Maybe a +mySafeButLast = fst . F.foldl (\(a,b) x -> (b,Just x)) (Nothing, Nothing) diff --git a/H20.hs b/H20.hs new file mode 100644 index 0000000..670edf6 --- /dev/null +++ b/H20.hs @@ -0,0 +1,7 @@ +import Control.Arrow +removeAt :: Int -> [a] -> [a] +removeAt n xs = (take (n-1) xs) ++ (drop n xs) + +removeAtT :: Int -> [a] -> (a,[a]) +removeAtT 1 (x:xs) = (x,xs) +removeAtT n (x:xs) = (fst &&& ((x:).snd)) $ removeAtT (n-1) xs diff --git a/H21.hs b/H21.hs new file mode 100644 index 0000000..c23b31b --- /dev/null +++ b/H21.hs @@ -0,0 +1,2 @@ +insertAt :: a -> [a] -> Int -> [a] +insertAt x xs c = let k = c-1 in take k xs ++ x:(drop k xs) diff --git a/H22.hs b/H22.hs new file mode 100644 index 0000000..3557f07 --- /dev/null +++ b/H22.hs @@ -0,0 +1,8 @@ +range :: Int -> Int -> [Int] +range a b | a<=b = a:(range (a+1) b) + | otherwise = [] + +range' x y = take (y-x+1) $ iterate (+1) x + +range'' a b | a==b = [a] + | otherwise = a:range'' ((if a Int -> IO [a] +rnd_select _ 0 = return [] +rnd_select (x:xs) n = + do + r <- randomRIO (0, (length xs)) + if r < n + then do + rest <- rnd_select xs (n-1) + return (x : rest) + else rnd_select xs n + +rnd_select' xs n = do + gen <- getStdGen + return $ take n [ xs !! x | x <- randomRs (0, (length xs) - 1) gen] + +rnd_select'' :: Int -> [a] -> [a] +rnd_select'' n x = map (x!!) is + where is = take n . nub $ randomRs (0, length x - 1) (mkStdGen 100) diff --git a/H24.hs b/H24.hs new file mode 100644 index 0000000..0baeaba --- /dev/null +++ b/H24.hs @@ -0,0 +1,7 @@ +import System.Random +import Data.List +diffSelect :: Int -> Int -> IO [Int] +diffSelect c to = do + gen <- getStdGen + return $ take c . nub $ randomRs (1,to) gen + diff --git a/H25.hs b/H25.hs new file mode 100644 index 0000000..d590fce --- /dev/null +++ b/H25.hs @@ -0,0 +1,8 @@ +import System.Random + +rnd_permu :: [a] -> IO [a] +rnd_permu [] = return [] +rnd_permu (x:xs) = do + rand <- randomRIO (0, (length xs)) + rest <- rnd_permu xs + return $ let (ys,zs) = splitAt rand rest in ys++(x:zs) diff --git a/H26.hs b/H26.hs new file mode 100644 index 0000000..4497e8c --- /dev/null +++ b/H26.hs @@ -0,0 +1,5 @@ +combination :: Int -> [a] -> [[a]] +combination 0 _ = [[]] +combination _ [] = [] +combination c (x:xs) = (map (x:) (combination (c-1) xs)) ++ (combination c xs) + diff --git a/H27.hs b/H27.hs new file mode 100644 index 0000000..8c0dab1 --- /dev/null +++ b/H27.hs @@ -0,0 +1,13 @@ +import Control.Arrow +combination :: Int -> [a] -> [([a],[a])] +combination 0 xs = [([],xs)] +combination _ [] = [] +combination c (x:xs) = (map ((x:).fst &&& snd) (combination (c-1) xs)) ++ (map (fst &&& (x:).snd) (combination c xs)) + +group :: [Int] -> [a] -> [[[a]]] +group [] _ = [[]] +-- group [n] xs = map ((:[]).fst) (combination n xs) +group (n:ns) xs = concatMap (\(comb,rest) -> map (comb:) (group ns rest)) (combination n xs) + +group' [] = const [[]] +group' (n:ns) = concatMap (uncurry $ (. group' ns) . map . (:)) . combination n diff --git a/H28.hs b/H28.hs new file mode 100644 index 0000000..0ff75cc --- /dev/null +++ b/H28.hs @@ -0,0 +1,11 @@ +import Data.List +import Data.Ord (comparing) +import Data.Function + +lsort :: [[a]] -> [[a]] +lsort = sortBy (comparing length) + +lsort' = sortBy (\xs ys -> compare (length xs) (length ys)) + +lsort'' = sortBy (compare `on` length) + diff --git a/H28n.hs b/H28n.hs new file mode 100644 index 0000000..bf584c7 --- /dev/null +++ b/H28n.hs @@ -0,0 +1,14 @@ +import Control.Arrow ((>>>), (&&&), second) +import GHC.Exts (sortWith) + +lfsort :: [[a]] -> [[a]] +lfsort = zip [1..] >>> map (second (length &&& id)) >>> sortWith (snd>>>fst) + >>> cntDupLength undefined [] >>> sortWith (snd>>>fst) + >>> sortWith fst >>> map (\(_,(_,(_,a))) -> a) + where + cntDupLength :: Int -> [(Int,(Int,a))] -> [(Int,(Int,a))] -> [(Int,(Int,(Int,a)))] + cntDupLength _ lls [] = map ((,) (length lls)) $ reverse lls + cntDupLength _ [] (x@(_,(l,_)):xs) = cntDupLength l [x] xs + cntDupLength l lls ys@(x@(_,(l1,_)):xs) + | l == l1 = cntDupLength l (x:lls) xs + | otherwise = (map ((,) (length lls)) $ reverse lls) ++ cntDupLength undefined [] ys diff --git a/H3.hs b/H3.hs new file mode 100644 index 0000000..7c8604d --- /dev/null +++ b/H3.hs @@ -0,0 +1,7 @@ +elementAt :: [a] -> Integer -> Maybe a + +elementAt [] _ = Nothing +elementAt (x:xs) 1 = Just x +elementAt (x:xs) n + | n>1 = elementAt xs (n-1) + | otherwise = Nothing diff --git a/H31.hs b/H31.hs new file mode 100644 index 0000000..9c321ca --- /dev/null +++ b/H31.hs @@ -0,0 +1,15 @@ +import System.Random + +isPrime :: Integral a => a -> Bool +isPrime x = and $ fmap ((/=0).(mod x)) [2..(x-1)] + +testn = 10 + +isPrimeT 2 = True +isPrimeT x = and $ fmap ((/=0).(fstPow x (x-1))) $ take testn $ randomRs (2,(x-1)) (mkStdGen 100) + +fstPow _ 1 x = x +fstPow m y x + | y `mod` 2 == 1 = (x * (fstPow m (y `div` 2) (sqr x))) `mod` m + | otherwise = fstPow m (y `div` 2) (sqr x) + where sqr a = (a*a) `mod` m diff --git a/H32.hs b/H32.hs new file mode 100644 index 0000000..2a0fa88 --- /dev/null +++ b/H32.hs @@ -0,0 +1,3 @@ +myGCD :: Integral a => a -> a -> a +myGCD x 0 = x +myGCD x y = myGCD y (x `mod` y) diff --git a/H33.hs b/H33.hs new file mode 100644 index 0000000..a707db5 --- /dev/null +++ b/H33.hs @@ -0,0 +1,3 @@ +coprime :: Integral a => a -> a -> Bool +coprime x 0 = x == 1 +coprime x y = coprime y (x `mod` y) diff --git a/H34.hs b/H34.hs new file mode 100644 index 0000000..6db5e5d --- /dev/null +++ b/H34.hs @@ -0,0 +1,3 @@ +-- http://en.wikipedia.org/wiki/Euler%27s_totient_function +totient :: Integral a => a -> Bool +totient x = length $ filter ((==1).(gcd x)) [1..x] diff --git a/H35.hs b/H35.hs new file mode 100644 index 0000000..1d96e4e --- /dev/null +++ b/H35.hs @@ -0,0 +1,21 @@ +module H35 +( primeFactors +) where + +primeSift (x:xs) = (x:) $ primeSift $ filter ((/=0).(`mod` x)) xs + +primes = primeSift [2..] + +primeFactors x = pF x primes + where + pF a xxs@(x:xs) + | a == 1 = [] + | a `mod` x == 0 = x:(pF (div a x) xxs) + | otherwise = pF a xs + +factor :: Integer -> [Integer] + +factor 1 = [] +factor n = + let prime = head $ dropWhile ((/= 0) . mod n) [2 .. n] + in (prime :) $ factor $ div n prime diff --git a/H36.hs b/H36.hs new file mode 100644 index 0000000..3cd36eb --- /dev/null +++ b/H36.hs @@ -0,0 +1,4 @@ +import H35 +import H10 + +primeFactorsMult n = encode $ primeFactors n diff --git a/H4.hs b/H4.hs new file mode 100644 index 0000000..1aea629 --- /dev/null +++ b/H4.hs @@ -0,0 +1,3 @@ +myLength :: [a] -> Integer + +myLength = foldl (\x _ -> x+1) 0 diff --git a/H5.hs b/H5.hs new file mode 100644 index 0000000..720eb9f --- /dev/null +++ b/H5.hs @@ -0,0 +1,3 @@ +myReverse :: [a] -> [a] + +myReverse = foldl (flip $ (:)) [] diff --git a/H6.hs b/H6.hs new file mode 100644 index 0000000..dc643eb --- /dev/null +++ b/H6.hs @@ -0,0 +1,11 @@ +import Control.Monad +import Control.Applicative + +isPalindrome :: Eq a => [a] -> Bool +isPalindrome xs = xs == reverse xs + +isPalindrome' :: (Eq a) => [a] -> Bool +isPalindrome' = liftM2 (==) id reverse + +isPalindrome'' :: (Eq a) => [a] -> Bool +isPalindrome'' = (==) <*> reverse diff --git a/H7.hs b/H7.hs new file mode 100644 index 0000000..c67b5c5 --- /dev/null +++ b/H7.hs @@ -0,0 +1,5 @@ +data NestedList a = Elem a | List [NestedList a] + +myFlatten :: NestedList a -> [a] +myFlatten (Elem x) = [x] +myFlatten (List x) = concatMap myFlatten x diff --git a/H8.hs b/H8.hs new file mode 100644 index 0000000..219bc93 --- /dev/null +++ b/H8.hs @@ -0,0 +1,12 @@ +compress :: (Eq a) => [a] -> [a] +compress = foldr elim [] + where elim e [] = [e] + elim e ns + | e == head ns = ns + | otherwise = e:ns + +compress' xs = foldr f (const []) xs Nothing + where + f x r a@(Just q) + | x == q = r a + f x r _ = x : r (Just x) diff --git a/H9.hs b/H9.hs new file mode 100644 index 0000000..b190491 --- /dev/null +++ b/H9.hs @@ -0,0 +1,13 @@ +pack :: (Eq a) => [a] -> [[a]] +pack = foldr elim [] + where elim e [] = [[e]] + elim e p@(n:ns) + | e == head n = (e:n):ns + | otherwise = [e]:p + +pack' (x:xs) = let (first,rest) = span (==x) xs + in (x:first) : pack' rest +pack' [] = [] + +pack'' (x:xs) = (x:takeWhile (==x) xs):(pack'' $ dropWhile (==x) xs) +pack'' [] = [] diff --git a/h1.hs b/h1.hs deleted file mode 100644 index f0216c2..0000000 --- a/h1.hs +++ /dev/null @@ -1,9 +0,0 @@ - -myLast :: [a] -> a -myLast [] = error "Empty List" -myLast [x] = x -myLast (x:xs) = myLast xs - -myLast' = foldl1 (flip const) - -myLast'' = foldl1 (curry snd) diff --git a/h10.hs b/h10.hs deleted file mode 100644 index 68ffade..0000000 --- a/h10.hs +++ /dev/null @@ -1,20 +0,0 @@ -import Control.Applicative -import Control.Arrow -import Data.List - -encode :: Eq a => [a] -> [(a,Int)] -encode = foldr elim [] - where - elim e [] = [(e,1)] - elim e p@(n:ns) - | e == fst n = (e,1 + (snd n)):ns - | otherwise = (e,1):p - -encode' (x:xs) = let (first,rest) = span (==x) xs - in (x,1+(length first)) : encode' rest - -encode' [] = [] - -encode'' xs = map (head &&& length) $ group xs - -encode''' xs = map ((,) <$> head <*> length) $ group xs diff --git a/h11.hs b/h11.hs deleted file mode 100644 index 77b7295..0000000 --- a/h11.hs +++ /dev/null @@ -1,15 +0,0 @@ -import Control.Arrow -import Data.List - -data ListItem a = Single a | Multiple a Int - deriving (Show) - -encode :: Eq a => [a] -> [(a,Int)] -encode xs = map (head &&& length) $ group xs - -encodeModified :: Eq a => [a] -> [ListItem a] -encodeModified = map helper . encode - where - helper (a,1) = Single a - helper (a,c) = Multiple a c - diff --git a/h12.hs b/h12.hs deleted file mode 100644 index 9b1b50e..0000000 --- a/h12.hs +++ /dev/null @@ -1,8 +0,0 @@ -data ListItem a = Single a | Multiple a Int - deriving (Show) - -decodeModified :: [ListItem a] -> [a] -decodeModified = concatMap decodeHelper - where - decodeHelper (Single a) = [a] - decodeHelper (Multiple a b) = replicate b a diff --git a/h13.hs b/h13.hs deleted file mode 100644 index ec0a395..0000000 --- a/h13.hs +++ /dev/null @@ -1,15 +0,0 @@ -data ListItem a = Single a | Multiple a Int - deriving (Show) - -encode :: Eq a => [a] -> [(a,Int)] -encode = foldr encodeHelper [] - where - encodeHelper a p@((x,c):ps) | x==a = (a,c+1):ps - encodeHelper a p = (a,1):p - -encodeDirect :: Eq a => [a] -> [ListItem a] -encodeDirect = map encodeHelper . encode - where - encodeHelper (a,c) - | c>1 = Multiple a c - | otherwise = Single a diff --git a/h14.hs b/h14.hs deleted file mode 100644 index e7ad73d..0000000 --- a/h14.hs +++ /dev/null @@ -1,10 +0,0 @@ -import Control.Applicative - -dupli :: [a] -> [a] -dupli = concatMap (replicate 2) - -dupli' xs = concat [ [x,x] | x <- xs ] - -dupli'' = (<**> [id,id]) - -dupli''' = foldr ((.) <$> (:) <*> (:)) [] diff --git a/h15.hs b/h15.hs deleted file mode 100644 index a8f84c1..0000000 --- a/h15.hs +++ /dev/null @@ -1,11 +0,0 @@ -import Control.Monad - -repli :: [a] -> [a] -repli xs n = concatMap (replicate n) xs - -repli' = flip $ concatMap . replicate - -repli'' xs n = xs >>= replicate n - -repli''' [] _ = [] -repli''' (x:xs) n = foldr (const (x:)) (repli xs n) [1..n] diff --git a/h16.hs b/h16.hs deleted file mode 100644 index 68978a7..0000000 --- a/h16.hs +++ /dev/null @@ -1,2 +0,0 @@ -dropEvery :: [a] -> Int -> [a] -dropEvery xs c = [x| (x,y) <- (zip xs [1..]), y `mod` c /= 0 ] diff --git a/h17.hs b/h17.hs deleted file mode 100644 index fa26f35..0000000 --- a/h17.hs +++ /dev/null @@ -1,10 +0,0 @@ -split :: [a] -> Int -> ([a],[a]) -split xs c = splitHelper [] xs c - where - splitHelper pre nxt 0 = (reverse pre, nxt) - splitHelper pre (x:nxt) c = splitHelper (x:pre) nxt (c-1) - -split' (x:xs) c | c>0 = - let (pre,nxt) = split' xs (c-1) - in (x:pre,nxt) -split' xs _ = ([],xs) diff --git a/h18.hs b/h18.hs deleted file mode 100644 index b9e8192..0000000 --- a/h18.hs +++ /dev/null @@ -1,7 +0,0 @@ -slice :: [a] -> Int -> Int -> [a] -slice (x:xs) a b - | a > 1 = slice xs (a-1) (b-1) - | a <= 1 && b >= 1 = x:(slice xs (a-1) (b-1)) - | otherwise = [] - -slice' xs i j = [x | (x,k)<- (zip xs [1..j]) , k >= i] diff --git a/h19.hs b/h19.hs deleted file mode 100644 index 45c5a07..0000000 --- a/h19.hs +++ /dev/null @@ -1,6 +0,0 @@ -rotate :: [a] -> Int -> [a] -rotate xs c - | c < 0 = rotate xs (c + (length xs)) - | otherwise = (drop (c `mod` (length xs)) xs ) ++ (take (c `mod` (length xs)) xs) - -rotate' xs c = take (length xs) $ drop (length xs + c) $ cycle xs diff --git a/h2.hs b/h2.hs deleted file mode 100644 index 60693ef..0000000 --- a/h2.hs +++ /dev/null @@ -1,11 +0,0 @@ -import Data.Foldable as F - -myButLast :: Foldable f => f a -> a - -myButLast = fst . F.foldl (\(a,b) x -> (b,x)) (err1, err2) - where - err1 = error "Empty list" - err2 = error "Not enough elements" - -mySafeButLast :: Foldable f => f a -> Maybe a -mySafeButLast = fst . F.foldl (\(a,b) x -> (b,Just x)) (Nothing, Nothing) diff --git a/h20.hs b/h20.hs deleted file mode 100644 index 670edf6..0000000 --- a/h20.hs +++ /dev/null @@ -1,7 +0,0 @@ -import Control.Arrow -removeAt :: Int -> [a] -> [a] -removeAt n xs = (take (n-1) xs) ++ (drop n xs) - -removeAtT :: Int -> [a] -> (a,[a]) -removeAtT 1 (x:xs) = (x,xs) -removeAtT n (x:xs) = (fst &&& ((x:).snd)) $ removeAtT (n-1) xs diff --git a/h21.hs b/h21.hs deleted file mode 100644 index c23b31b..0000000 --- a/h21.hs +++ /dev/null @@ -1,2 +0,0 @@ -insertAt :: a -> [a] -> Int -> [a] -insertAt x xs c = let k = c-1 in take k xs ++ x:(drop k xs) diff --git a/h22.hs b/h22.hs deleted file mode 100644 index 3557f07..0000000 --- a/h22.hs +++ /dev/null @@ -1,8 +0,0 @@ -range :: Int -> Int -> [Int] -range a b | a<=b = a:(range (a+1) b) - | otherwise = [] - -range' x y = take (y-x+1) $ iterate (+1) x - -range'' a b | a==b = [a] - | otherwise = a:range'' ((if a Int -> IO [a] -rnd_select _ 0 = return [] -rnd_select (x:xs) n = - do - r <- randomRIO (0, (length xs)) - if r < n - then do - rest <- rnd_select xs (n-1) - return (x : rest) - else rnd_select xs n - -rnd_select' xs n = do - gen <- getStdGen - return $ take n [ xs !! x | x <- randomRs (0, (length xs) - 1) gen] - -rnd_select'' :: Int -> [a] -> [a] -rnd_select'' n x = map (x!!) is - where is = take n . nub $ randomRs (0, length x - 1) (mkStdGen 100) diff --git a/h24.hs b/h24.hs deleted file mode 100644 index 0baeaba..0000000 --- a/h24.hs +++ /dev/null @@ -1,7 +0,0 @@ -import System.Random -import Data.List -diffSelect :: Int -> Int -> IO [Int] -diffSelect c to = do - gen <- getStdGen - return $ take c . nub $ randomRs (1,to) gen - diff --git a/h25.hs b/h25.hs deleted file mode 100644 index d590fce..0000000 --- a/h25.hs +++ /dev/null @@ -1,8 +0,0 @@ -import System.Random - -rnd_permu :: [a] -> IO [a] -rnd_permu [] = return [] -rnd_permu (x:xs) = do - rand <- randomRIO (0, (length xs)) - rest <- rnd_permu xs - return $ let (ys,zs) = splitAt rand rest in ys++(x:zs) diff --git a/h26.hs b/h26.hs deleted file mode 100644 index 4497e8c..0000000 --- a/h26.hs +++ /dev/null @@ -1,5 +0,0 @@ -combination :: Int -> [a] -> [[a]] -combination 0 _ = [[]] -combination _ [] = [] -combination c (x:xs) = (map (x:) (combination (c-1) xs)) ++ (combination c xs) - diff --git a/h27.hs b/h27.hs deleted file mode 100644 index 8c0dab1..0000000 --- a/h27.hs +++ /dev/null @@ -1,13 +0,0 @@ -import Control.Arrow -combination :: Int -> [a] -> [([a],[a])] -combination 0 xs = [([],xs)] -combination _ [] = [] -combination c (x:xs) = (map ((x:).fst &&& snd) (combination (c-1) xs)) ++ (map (fst &&& (x:).snd) (combination c xs)) - -group :: [Int] -> [a] -> [[[a]]] -group [] _ = [[]] --- group [n] xs = map ((:[]).fst) (combination n xs) -group (n:ns) xs = concatMap (\(comb,rest) -> map (comb:) (group ns rest)) (combination n xs) - -group' [] = const [[]] -group' (n:ns) = concatMap (uncurry $ (. group' ns) . map . (:)) . combination n diff --git a/h28.hs b/h28.hs deleted file mode 100644 index 0ff75cc..0000000 --- a/h28.hs +++ /dev/null @@ -1,11 +0,0 @@ -import Data.List -import Data.Ord (comparing) -import Data.Function - -lsort :: [[a]] -> [[a]] -lsort = sortBy (comparing length) - -lsort' = sortBy (\xs ys -> compare (length xs) (length ys)) - -lsort'' = sortBy (compare `on` length) - diff --git a/h28n.hs b/h28n.hs deleted file mode 100644 index bf584c7..0000000 --- a/h28n.hs +++ /dev/null @@ -1,14 +0,0 @@ -import Control.Arrow ((>>>), (&&&), second) -import GHC.Exts (sortWith) - -lfsort :: [[a]] -> [[a]] -lfsort = zip [1..] >>> map (second (length &&& id)) >>> sortWith (snd>>>fst) - >>> cntDupLength undefined [] >>> sortWith (snd>>>fst) - >>> sortWith fst >>> map (\(_,(_,(_,a))) -> a) - where - cntDupLength :: Int -> [(Int,(Int,a))] -> [(Int,(Int,a))] -> [(Int,(Int,(Int,a)))] - cntDupLength _ lls [] = map ((,) (length lls)) $ reverse lls - cntDupLength _ [] (x@(_,(l,_)):xs) = cntDupLength l [x] xs - cntDupLength l lls ys@(x@(_,(l1,_)):xs) - | l == l1 = cntDupLength l (x:lls) xs - | otherwise = (map ((,) (length lls)) $ reverse lls) ++ cntDupLength undefined [] ys diff --git a/h3.hs b/h3.hs deleted file mode 100644 index 7c8604d..0000000 --- a/h3.hs +++ /dev/null @@ -1,7 +0,0 @@ -elementAt :: [a] -> Integer -> Maybe a - -elementAt [] _ = Nothing -elementAt (x:xs) 1 = Just x -elementAt (x:xs) n - | n>1 = elementAt xs (n-1) - | otherwise = Nothing diff --git a/h4.hs b/h4.hs deleted file mode 100644 index 1aea629..0000000 --- a/h4.hs +++ /dev/null @@ -1,3 +0,0 @@ -myLength :: [a] -> Integer - -myLength = foldl (\x _ -> x+1) 0 diff --git a/h5.hs b/h5.hs deleted file mode 100644 index 720eb9f..0000000 --- a/h5.hs +++ /dev/null @@ -1,3 +0,0 @@ -myReverse :: [a] -> [a] - -myReverse = foldl (flip $ (:)) [] diff --git a/h6.hs b/h6.hs deleted file mode 100644 index dc643eb..0000000 --- a/h6.hs +++ /dev/null @@ -1,11 +0,0 @@ -import Control.Monad -import Control.Applicative - -isPalindrome :: Eq a => [a] -> Bool -isPalindrome xs = xs == reverse xs - -isPalindrome' :: (Eq a) => [a] -> Bool -isPalindrome' = liftM2 (==) id reverse - -isPalindrome'' :: (Eq a) => [a] -> Bool -isPalindrome'' = (==) <*> reverse diff --git a/h7.hs b/h7.hs deleted file mode 100644 index c67b5c5..0000000 --- a/h7.hs +++ /dev/null @@ -1,5 +0,0 @@ -data NestedList a = Elem a | List [NestedList a] - -myFlatten :: NestedList a -> [a] -myFlatten (Elem x) = [x] -myFlatten (List x) = concatMap myFlatten x diff --git a/h8.hs b/h8.hs deleted file mode 100644 index 219bc93..0000000 --- a/h8.hs +++ /dev/null @@ -1,12 +0,0 @@ -compress :: (Eq a) => [a] -> [a] -compress = foldr elim [] - where elim e [] = [e] - elim e ns - | e == head ns = ns - | otherwise = e:ns - -compress' xs = foldr f (const []) xs Nothing - where - f x r a@(Just q) - | x == q = r a - f x r _ = x : r (Just x) diff --git a/h9.hs b/h9.hs deleted file mode 100644 index b190491..0000000 --- a/h9.hs +++ /dev/null @@ -1,13 +0,0 @@ -pack :: (Eq a) => [a] -> [[a]] -pack = foldr elim [] - where elim e [] = [[e]] - elim e p@(n:ns) - | e == head n = (e:n):ns - | otherwise = [e]:p - -pack' (x:xs) = let (first,rest) = span (==x) xs - in (x:first) : pack' rest -pack' [] = [] - -pack'' (x:xs) = (x:takeWhile (==x) xs):(pack'' $ dropWhile (==x) xs) -pack'' [] = [] -- cgit v1.2.3-70-g09d2