niming538's blog

Prelude> :set prompt "ghci> "
ghci>

ghci> print "hello, world" -- > "hello, world"

ghci> Ctrl-D
Leaving GHCi.

Prelude> :quit
Leaving GHCi.

-- hello01.hs
main = putStrLn "hello, world

$ runghc hello01.hs
hello, world

-- import01.hs
import System.IO

main = do
handle <- openFile "baabaa.txt" ReadMode
contents <- hGetContents handle
putStr contents
hClose handle

Prelude> 12 `mod` 7 -- > 5
Prelude> mod 12 7 -- > 5
Prelude> 3 ^ 4 -- > 81
Prelude> 3 ** 4 -- > 81.0

-- fact01.hs

fact :: Integer -> Integer
fact 0 = 1
fact n = n * fact(n - 1)

*Main> map fact [1..7] -- > [1,2,6,24,120,720,5040]

-- fact02.hs
fact :: Integer -> Integer
fact n = if n == 0 then 1 else n * fact (n - 1)

-- main01.hs
main = print (map fac [1..7])
fac 0 = 1
fac n = n * fac(n - 1)

*Main> main
[1,2,6,24,120,720,5040]

*Main> fact 10
3628800

runghc main01.hs
[1,2,6,24,120,720,5040]

*Main> :load main01.hs
[1 of 1] Compiling Main ( main01.hs, interpreted )
Ok, modules loaded: Main.

*Main> :load
Ok, modules loaded: none.

Prelude> :reload
Ok, modules loaded: none.

Prelude> :load main01
[1 of 1] Compiling Main ( main01.hs, interpreted )
Ok, modules loaded: Main.

*Main> :reload
Ok, modules loaded: Main.

-- fibo01.hs
fibo :: Integer -> Integer
fibo n =
if n == 0 || n == 1 then 1
else fibo (n - 1) + fibo (n - 2)

*Main> map fibo [0,1,2,3,4,5,10,20]
[1,1,2,3,5,8,89,10946]

-- fibo02.hs

fibo :: Integer -> Integer
fibo 0 = 1
fibo 1 = 1
fibo n = fibo(n - 1) + fibo(n - 2)

-- Guards: an easy way to do branching in functions
fib x
| x < 2 = 1
| otherwise = fib (x - 1) + fib (x - 2)

-- gcd01.hs

gcd' :: Integer -> Integer -> Integer
gcd' a b = if b == 0 then a else gcd' b (a `mod` b)

-- gcd02.hs

gcd' :: (Integer,Integer) -> Integer
gcd' (a, b) = if b == 0 then a else gcd' (b, a `mod` b)

-- gcd03.hs

gcd' :: Integer -> Integer -> Integer
gcd' a 0 = a
gcd' a b = gcd' b (mod a b)

-- lcm01.hs

lcm' :: Integer -> Integer -> Integer
lcm' a b = a * b `div` gcd a b

-- comb01.hs

comb :: Integer -> Integer -> Integer
comb n r =
if n == r || r == 0 then 1
else (comb n (r - 1)) * (n - r + 1) `div` r

*Main> comb 20 10
184756
*Main> comb 30 15
155117520
*Main> comb 40 20
137846528820
*Main> comb 100 100
1
*Main> comb 100 40
13746234145802811501267369720
*Main> comb 0 1
0

-- main03.hsi
main = do putStrLn "What is 2 + 2?"
x <- readLn
if x == 4
then putStrLn "You're right!"
else putStrLn "You're wrong!"

-- main02.hs
main = do
print (map fact [1..7])
print "hello"
print "world"
fact 0 = 1
fact n = n * fact(n - 1)

*Main> do { n <- readLn ; print (n^2) }
4
16

*Main> :{
*Main| fact 0 = 1
*Main| fact n = n * fact ( n - 1)
*Main| :}
*Main> fact 10
3628800
*Main> fact 5
120

Prelude> "hello" ++ ", haskell"
"hello, haskell"

Prelude> succ 5
6
Prelude> succ 'a'
'b'
Prelude> truncate 6.59
6
Prelude> round 6.59
7
Prelude> floor 6.59
6
Prelude> ceiling 6.59
7
Prelude> sqrt 2
1.4142135623730951
Prelude> 2 ^ (1/2)
error
Prelude> 2 ** (1 / 2)
1.4142135623730951
Prelude> 2 ^ 2
4
Prelude> 2 ** 2
4.0
Prelude> 10 `div` 3
3
Prelude> 10 / 3
3.3333333333333335
Prelude> subtract 12 10
-2
Prelude> 12 `subtract` 10
-2
Prelude> abs (-1)
1
Prelude> odd 10
False
Prelude> even 10
True

Prelude> a = 98709870987098709879087098790870987098709870
Prelude> a :: Integer
98709870987098709879087098790870987098709870
Prelude> a :: Int
-4297554779504746642

Prelude> let square :: Int -> Int; square x = x * x
Prelude> square 3678

Prelude> :{
Prelude| let fact :: Int -> Int
Prelude| fact 0 = 1
Prelude| fact n = n * fact (n - 1)
Prelude| :}
Prelude> fact 5
120

Prelude> zip [1,5] [5, 5, 5, 5, 5]
[(1,5),(5,5)]
Prelude> zip [1..5] [5, 5, 5, 5, 5]
[(1,5),(2,5),(3,5),(4,5),(5,5)]
Prelude> zip [1..5] [5, 5]
[(1,5),(2,5)]

Prelude> :t zip
zip :: [a] -> [b] -> [(a, b)]

Prelude> words "These are the words this text in this sentence. hey"
["These","are","the","words","this","text","in","this","sentence.","hey"]
Prelude> length $ words "These are the words this text in this sentence. hey"
10

-- factorial01.hs

factorial :: Integer -> Integer
factorial n = product [1..n]

*Main> factorial 50
30414093201713378043612608166064768844377641568960512000000000000

Prelude> -- cons : operator
Prelude> 't':"jjk;lkj "
"tjjk;lkj "
Prelude> 3:[2,3,4]
[3,2,3,4]

Prelude> 2 /= 3
True
Prelude> not (2 /= 3)
False

Prelude> pi
3.141592653589793

Prelude> let e = exp 1
Prelude> e
2.718281828459045

Prelude> [1.0 , 1.25..7]
[1.0,1.25,1.5,1.75,2.0,2.25,2.5,2.75,3.0,3.25,3.5,3.75,4.0,4.25,4.5,4.75,5.0,5.25,5.5,5.75,6.0,6.25,6.5,6.75,7.0]
Prelude> [1,4..15]
[1,4,7,10,13]
Prelude> [10,7..(-10)]
[10,7,4,1,-2,-5,-8]

Prelude> 5 / 2 -- => 2.5
Prelude> div 5 2 -- => 2
Prelude> mod 5 2 -- => 1
Prelude> (+) 3 4 -- => 7
Prelude> (-) 3 4 -- => -1

Prelude> let f x = x + 2
Prelude> print $ f 3 -- => 5

Prelude> [1,2,3,4,5] !! 3 -- => 4
Prelude> [1,2,3,4,5] !! 0 -- => 1
Prelude> [1,2,3,4,5] !! (-1) -- => error
Prelude> take 3 [1,2,3,4,5] -- =>[1,2,3]
Prelude> [1..5] ++ [6] -- => [1,2,3,4,5,6]
Prelude> 1:2:[3,4,5] -- => [1,2,3,4,5]

Prelude> "abcde" -- => "abcde"
Prelude> ['a','b','c','d','e'] -- => "abcde"
Prelude> ['a' .. 'e'] -- => "abcde"
Prelude> 'a':'b':"cde" -- => "abcde"
Prelude> "abc" ++ "de" -- => "abcde"
Prelude> "abcde" !! 3 -- => 'd'

Prelude> :set +t
Prelude> 3
3

Prelude> :m +Data.Ratio
Prelude Data.Ratio> 11 % 29
11 % 29
it :: Integral a => Ratio a

Prelude Data.Ratio> last [1..5] -- => 5

Prelude Data.Ratio> init [1..5] -- => [1,2,3,4]

Prelude> let average ns = div (sum ns) (length ns)
average :: Foldable t => t Int -> Int
Prelude> average [1..10]
5

Prelude> let a = b + c where {b = 1; c = 2}
Prelude> a
3

Prelude> :t not
not :: Bool -> Bool

-- lambda expression == anonymous function

Prelude> (\x -> x + 1) 5
6
Prelude> let inc = \x -> x + 1
Prelude> inc 5
6

-- intentional definition 内包表記
Prelude> [x^2 | x <- [1..5]]
[1,4,9,16,25]

Prelude> [(x, y) | x <- [1,2,3], y <-[4,5]]
[(1,4),(1,5),(2,4),(2,5),(3,4),(3,5)]
Prelude> [(x, y) | y <-[4,5], x <- [1,2,3]]
[(1,4),(2,4),(3,4),(1,5),(2,5),(3,5)]
Prelude> [(x, y) | x <- [1,2,3], y <-[x..3]]
[(1,1),(1,2),(1,3),(2,2),(2,3),(3,3)]

Prelude> let concat' :: a -> [a] ; concat' xss = [x | xs <- xss, x <- xs]
Prelude> concat' [[3],[4]]
[3,4]

Prelude> let firsts ps = [x | (x,_) <- ps]
Prelude> firsts [(3,4)]
[3]
Prelude> firsts [(3,4),(5,6)]
[3,5]
Prelude> :t firsts
firsts :: [(t, t1)] -> [t]

Prelude> :t length
length :: Foldable t => t a -> Int
Prelude> let length' xs = sum [ 1 | _ <- xs]
Prelude> :t length'
length' :: Num a => [t] -> a
Prelude> length' [1..5]
5
Prelude> length' "abcde"
5

Prelude> let factors n = [x | x <- [1..n], (mod n x) == 0]
Prelude> factors 15
[1,3,5,15]
Prelude> factors 7
[1,7]
Prelude> :t factors
factors :: Integral t => t -> [t]
Prelude> let prime n = factors n == [1,n]
Prelude> prime 7
True
Prelude> prime 15
False
Prelude> let primes n = [x | x <- [2..n], prime x]
Prelude> primes 40
[2,3,5,7,11,13,17,19,23,29,31,37]

Prelude> let find k t = [v | (k', v) <- t, k == k']
Prelude> find 'b' [('a',1),('b',2),('c',3),('b',4)]
[2,4]

Prelude> let pairs xs = zip xs (tail xs)
Prelude> pairs [1,2,3,4]
[(1,2),(2,3),(3,4)]
Prelude> let sorted xs = and [ x <= y | (x, y) <- pairs xs]
Prelude> sorted [1,2,3,4]
True
Prelude> sorted [1,3,2,4]
False

Prelude> let positions x xs = [i | (x', i) <- zip xs [0..n], x == x'] where n = length xs - 1
Prelude> positions False [True, False, True, False]
[1,3]
Prelude> :t positions
positions :: Eq a => a -> [a] -> [Int]

Prelude> let positions x xs = [i | (x', i) <- zip xs [0..], x == x']
Prelude> positions False [True, False, True, False]
[1,3]

-- wordcount01.hs

main = interact wordCount
where wordCount input = show (length (lines input)) ++ "\n"

-- quux.txt

Teignmouth, England
Paris, France
Ulm, Germany
Auxerre, France
Brunswick, Germany
Beaumont-en-Auge, France
Ryazan, Russia

$ runghc wordcount01.hs < quux.txt
7
$ cat quux.txt | runghc wordcount01.hs
7

Prelude> pi
3.141592653589793
Prelude> sin (pi / 2)
1.0
Prelude> pred 9
8
Prelude> sqrt 2
1.4142135623730951
Prelude> truncate pi
3
Prelude> let x = 1
Prelude> :show bindings
it :: Integral b => b = _
x :: Num a => a = _

Prelude System.IO> :m Data.Char
Prelude Data.Char> let lowers xs = length [ x | x <- xs, isLower x]
Prelude Data.Char> lowers "Haskell"
6
Prelude Data.Char> let count x xs = length [ x' | x' <- xs, x == x']
Prelude Data.Char> count 's' "Mississippi"
4

-- crypt01.hs
import Data.Char

let2int :: Char -> Int
let2int c = ord c - ord 'a'

int2let :: Int -> Char
int2let n = chr (ord 'a' + n)

shift :: Int -> Char -> Char
shift n c |isLower c = int2let (mod (let2int c + n) 26)
|otherwise = c
encode n xs = [shift n x | x <- xs]

Prelude> :l crypt01
[1 of 1] Compiling Main ( crypt01.hs, interpreted )
Ok, modules loaded: Main.
*Main> shift 3 'a'
'd'
*Main> shift 3 'z'
'c'
*Main> shift (-3) 'c'
'z'
*Main> shift 3 ' '
' '

*Main> encode 3 "haskell is fun"
"kdvnhoo lv ixq"

*Main> encode (-3) "kdvnhoo lv ixq"
"haskell is fun"

table :: [Float]
table = [8.2,1.5,2.8,4.3,12.7,2.2,2.0,6.1,7.0,0.2,0.8,4.0,2.4,
6.7,7.5,1.9,0.1,6.0,6.3,9.1,2.8,1.0,2.4,0.2,2.0,0.1]

Prelude> let percent n m = (fromIntegral n / fromIntegral m)*100
Prelude> percent 90 108
83.33333333333334

freqs :: String -> [Float]
freqs xs= [percent (count x xs) n | x <- ['a'..'z']]
where n = lowers xs

-- カイ二乗検定
chisqr :: [Float] -> [Float] -> Float
chisqr os es = sum [*1-x]
Prelude> perfects 500
[6,28,496]

Prelude> [(x,y) | x<-[1,2,3], y<-[4,5,6]]
[(1,4),(1,5),(1,6),(2,4),(2,5),(2,6),(3,4),(3,5),(3,6)]
Prelude> (x,y) | y<-[4..6 | x<-[1..3]]
[[(1,4),(1,5),(1,6)],[(2,4),(2,5),(2,6)],[(3,4),(3,5),(3,6)]]
Prelude> concat (x,y) | y<-[4..6 | x<-[1..3]]
[(1,4),(1,5),(1,6),(2,4),(2,5),(2,6),(3,4),(3,5),(3,6)]

Prelude> let positions x xs = [i | (x', i) <- zip xs [0..], x == x']
Prelude> positions False [True, False, True, False]
[1,3]

Prelude> let find k t = [v | (k', v) <- t, k == k']
Prelude> find 'b' [('a',1),('b',2),('c',3),('b',4)]
[2,4]

Prelude> let positions' x xs = find x [(x,y)| (x,y)<- zip xs [0..]]
Prelude> positions' False [True, False, True, False]
[1,3]

Prelude> let scalarproduct :: [Int] -> [Int] -> Int;scalarproduct xs ys = sum [x*y | (x,y)<- zip xs ys]
Prelude> scalarproduct [1,2,3][4,5,6]
32

-- crack02.hs 大文字対応版
import Data.Char

let2int :: Char -> Int
let2int c = ord c - ord 'a'
let2intUpper :: Char -> Int
let2intUpper c = ord c - ord 'A'

int2let :: Int -> Char
int2let n = chr (ord 'a' + n)
int2letUpper :: Int -> Char
int2letUpper n = chr(ord 'A' + n)

shift :: Int -> Char -> Char
shift n c |isLower c = int2let (mod (let2int c + n) 26)
|isUpper c = int2letUpper(mod (let2intUpper c + n) 26)
|otherwise = c

encode :: Int -> String -> String
encode n xs = [shift n x | x <- xs]

positions x xs = [i | (x', i) <- zip xs [0..], x == x']

freqs :: String -> [Float]
freqs xs = [percent (count x xs + count y xs) n | (x, y) <- zip ['a'..'z'] ['A'..'Z']]
where n = lowers xs + uppers xs

percent n m = (fromIntegral n / fromIntegral m)*100

count x xs = length [ x' | x' <- xs, x == x']

lowers xs = length [ x | x <- xs, isLower x]
uppers xs = length [ x | x <- xs, isUpper x]

table :: [Float]
table = [8.2,1.5,2.8,4.3,12.7,2.2,2.0,6.1,7.0,0.2,0.8,4.0,2.4,6.7,7.5,1.9,0.1,6.0,6.3,9.1,2.8,1.0,2.4,0.2,2.0,0.1]

crack xs = encode (-factor) xs
where
factor = head (positions (minimum chitab) chitab)
chitab = [chisqr (rotate n table') table | n <-[0..25] ]
table' = freqs xs

chisqr :: [Float] -> [Float] -> Float
chisqr os es = sum [*2
where n = (div (length xs) 2)

-- merge01.hs
merge :: Ord a => [a] -> [a] -> [a]
merge =
merge (x:xs) = x:xs
merge (y:ys) = y:ys
merge (x:xs) (y:ys) | x < y = x : merge xs (y:ys)
| otherwise = y : merge (x:xs) ys

*Main> msort [3, 2, 1, 8, 1 , 2 , 100, 4]
[1,1,2,2,3,4,8,100]

-- sum01.hs
sum' :: Num a => [a] -> a
sum' = 0
sum' (x:xs) = x + sum' xs

*Main> sum' [1..5]
15

-- take01.hs
take' :: Int -> [a] -> [a]
take' 0 (x:xs) =
take' n =
take' n (x:xs) = [x] ++ (take' (n - 1) xs)
-- 不具合 => nが負の数のとき、にならずに、元のリストが返されてしまいます。

*Main> take' 3 [1..5]
[1,2,3]
*Main> take' (-1) [1..5]
[1,2,3,4,5] -- => 不具合

-- last01.hs
last' :: [a] -> a
last' (x:) = x
last' (x:xs) = last' xs

*Main> last' [1,2,3]
3

-- add01.hs
add :: Int -> (Int -> Int)
add = \x -> (\y ->x + y)

*Main> add 3 4
7

-- twice01.hs
twice :: (a -> a) -> a -> a
twice f x = f (f x)

*Main> twice (* 2) 3
12

*Main> twice reverse [1,2,3]
[1,2,3]

-- map01.hs
map' :: (a -> b) -> [a] -> [b]
map' f xs = [ f x | x <- xs ]

-- map02.hs
map' :: (a -> b) -> [a] -> [b]
map' f =
map' f (x:xs) = (f x) : map f xs

*Main Data.Char> map' (+ 1) [1,3,5,7]
[2,4,6,8]
*Main Data.Char> map' isDigit ['a','1','b','2']
[False,True,False,True]
*Main Data.Char> map' reverse ["abc","def","ghi"]
["cba","fed","ihg"]
*Main Data.Char> map'(map'(+1))[[1,2,3],[4,5]]
[[2,3,4],[5,6]]

-- filter01.hs
filter' :: (a -> Bool) -> [a] -> [a]
filter' p xs = [x | x <- xs, p x]

-- filter02.hs
filter' p =
filter' p (x:xs) | p x = x : filter' p xs
| otherwise = filter' p xs

*Main> filter' even [1..10]
[2,4,6,8,10]
*Main> filter' (> 5) [1..10]
[6,7,8,9,10]
*Main> filter' (/= ' ') "abc def ghi"
"abcdefghi"

*Main> all even [2,4,6,8]
True
*Main> any odd [2,4,6,8]
False

*Main> :m Data.Char
Prelude Data.Char> takeWhile isLower "abc def"
"abc"
Prelude Data.Char> dropWhile isLower "abc def"
" def"

Prelude> let sum' = foldr (+) 0
Prelude> sum' [1..10]
55
Prelude> let product' = foldr (*) 1
Prelude> product' [1..10]
3628800
Prelude> let or' = foldr (||) False
Prelude> or' [False, False, False]
False
Prelude> or' [True, False, False]
True
Prelude> let and' = foldr (&&) True
Prelude> and' [False, True, True]
False
Prelude> and' [True, True, True]
True

-- foldr01.hs
foldr' :: (a -> b -> b) -> b -> [a] -> b
foldr' f v = v
foldr' f v (x:xs) = f x (foldr' f v xs)

*Main> foldr' (+) 0 [1..5]
15
*Main> foldr' (*) 1 [1..5]
120
*Main> foldr' (||) False [False, True, True]
True
*Main> foldr' (&&) True [False, True, True]
False

Prelude Data.Char> let sumsqreven :: [Int] -> Int ; sumsqreven ns = sum (map (^ 2) (filter even ns))
Prelude Data.Char> sumsqreven [1..10]
220
Prelude Data.Char> sumsqreven [1..5]
20

-- length02.hs
length' :: [a] -> Int
length' = foldr (\_ n -> 1+n) 0

*Main> length' "this is a pen."
14

-- reverse02.hs

reverse' :: [a] -> [a]
reverse' =
reverse' (x:xs) = snoc x (reverse' xs)

snoc :: a -> [a] -> [a]
snoc x xs = xs ++ [x]

*Main> reverse' "This"
"sihT"

*Main> let reverse2 = foldr snoc
*Main> reverse2 "That"
"tahT"

-- reverse03.hs

reverse' :: [a] -> [a]
reverse' = foldr snoc

snoc :: a -> [a] -> [a]
snoc x xs = xs ++ [x]
~

*Main> reverse' "Haskell"
"lleksaH"

-- error
-- (++ys) = foldr (:) ys

*Main> let sum' = foldl (+) 0
*Main> sum' [1..5]
15
*Main> let product' = foldl (*) 1
*Main> product' [1..5]
120
*Main> let or' = foldl (||) False
*Main> or' [False , True, True]
True
*Main> let and' = foldl (&&) True
*Main> and' [False , True, True]
False
*Main> let length' = foldl (\n _ -> n+1) 0
*Main> length' "whta"
4
*Main> let reverse' = foldl (\xs x -> x:xs)
*Main> reverse' "this word"
"drow siht"

— error
— (xs++) = foldl (\ys y -> ys ++ [y]) xs

-- foldl01.hs
foldl' :: (a -> b -> a) -> a -> [b] -> a
foldl' f v = v
foldl' f v (x:xs) = foldl f (f v x) xs

*Main> let and' = foldl' (&&) True
*Main> and' [True, True]
True

Prelude> :t foldl
foldl :: Foldable t => (b -> a -> b) -> b -> t a -> b

Prelude> foldl (\acc x -> acc + x ) 0 [1..5]
15

(.) :: (b -> c) -> (a -> b) -> (a -> c)
f.g = \x -> f (g x)

odd n = not (even n)
odd = not.even

twice f x = f (f x)
twice f = f.f

sumsqreven ns = sum (map (^2) (filter even ns))
sumsqreven = sum.map (^2).filter even

id :: a -> a
id = \x -> x

compose :: [a -> a] -> (a -> a)
compose = foldr (.) id

Prelude> let bin2int :: [Int] -> Int; bin2int bits = sum [w*b | (w,b) <- zip weights bits] where weights = iterate (*2) 1
Prelude> bin2int [1,1]
3
Prelude> bin2int [1,1,1,1]
15

-- bin2int01.hs
-- type Bit = Int
-- bin2int :: [Bit] -> Int
bin2int :: [Int] -> Int
bin2int bits = sum [ w * b | (w , b) <- zip weights bits]
where weights = iterate (* 2) 1

*Main> bin2int [1,0,0]
1
*Main> bin2int [0,0,1]
4

-- bin2int02.hs
bin2int :: [Int] -> Int
bin2int = foldr (\x y -> x + 2 * y) 0

-- bin2int [1,0,1,1]
-- 13

-- int2bin01.hs

int2bin :: Int -> [Int]
int2bin 0 =
int2bin n = mod n 2 : int2bin (div n 2)

-- int2bin 13
-- [1,0,1,1]

-- make801.hs
make8 :: [Int] -> [Int]
make8 bits = take 8 (bits ++ repeat 0)

-- =>
-- *Main> make8 [1,0,1,1]
-- [1,0,1,1,0,0,0,0]

-- enccode01.hs
import Data.Char

encode :: String -> [Int]
encode = concat.map (make8.int2bin.ord)

make8 :: [Int] -> [Int]
make8 bits = take 8 (bits ++ repeat 0)

int2bin :: Int -> [Int]
int2bin 0 =
int2bin n = mod n 2 : int2bin (div n 2)

-- =>

*Main Data.Char> encode "this is"
[0,0,1,0,1,1,1,0,0,0,0,1,0,1,1,0,1,0,0,1,0,1,1,0,1,1,0,0,1,1,1,0,0,0,0,0,0,1,0,0,1,0,0,1,0,1,1,0,1,1,0,0,1,1,1,0]
*Main Data.Char> :l decode01.hs

-- decode01.hs
import Data.Char

decode :: [Int] -> String
decode = map (chr.bin2int).chop8

chop8 :: [Int] -> [[Int]]
chop8 =
chop8 bits = take 8 bits : chop8 (drop 8 bits)

bin2int :: [Int] -> Int
bin2int = foldr (\x y -> x + 2 * y) 0

-- =>

*Main Data.Char> decode [0,0,1,0,1,1,1,0,0,0,0,1,0,1,1,0,1,0,0,1,0,1,1,0,1,1,0,0,1,1,1,0,0,0,0,0,0,1,0,0,1,0,0,1,0,1,1,0,1,1,0,0,1,1,1,0]
"this is"

-- transmit01.hs
import Data.Char

transmit :: String -> String
transmit = decode.channel.encode

channel :: [Int] -> [Int]
channel = id

encode :: String -> [Int]
encode = concat.map (make8.int2bin.ord)

make8 :: [Int] -> [Int]
make8 bits = take 8 (bits ++ repeat 0)

int2bin :: Int -> [Int]
int2bin 0 =
int2bin n = mod n 2 : int2bin (div n 2)

decode :: [Int] -> String
decode = map (chr.bin2int).chop8

chop8 :: [Int] -> [[Int]]
chop8 =
chop8 bits = take 8 bits : chop8 (drop 8 bits)

bin2int :: [Int] -> Int
bin2int = foldr (\x y -> x + 2 * y) 0

-- =>

*Main> transmit "this is a pen."
"this is a pen."

-- all01.hs
all' :: (a -> Bool) -> [a] -> Bool
all' p = True
all' p (x:xs) = ( p x ) && ( all' p xs )

-- =>

*Main> all odd [1..5]
False
*Main> all odd[1 , 3, 5, 7, 9]
True

-- any01.hs
any' :: (a -> Bool) -> [a] -> Bool
any' p = False
any' p (x:xs) = (p x) || (any' p xs)

-- =>

*Main> any odd [1..5]
True
*Main> any odd [4]

-- doubleme01.hs
doubleMe ::Num a => [a] -> [a]
doubleMe =
doubleMe (x:xs) = x*2:(doubleMe xs)

-- =>

*Main> doubleMe(doubleMe (doubleMe [1..5]))
[8,16,24,32,40]

-- takewhile01.hs
takeWhile' :: (a -> Bool) -> [a] -> [a]
takeWhile' p =
takeWhile' p (x:xs) | p x = x : takeWhile' p xs

*Main Data.Char> takeWhile' isLower "abcDef"
"abc"

-- dropwhile01.hs
dropWhile' :: (a -> Bool) -> [a] -> [a]
dropWhile' p =
dropWhile' p (x:xs) | p x = dropWhile' p xs
| otherwise = x:xs

*Main Data.Char> dropWhile' isLower "abdDEf"
"DEf"

-- map03.hs
map' :: (a -> b) -> [a] -> [b]
map' f = foldr ((:).f)

*Main Data.Char> map' odd [1..5]
[True,False,True,False,True]

-- cat01.hs
main = do cs <- getContents
putStr cs

-- =>

runghc cat01.hs < cat01.hs
-- cat01.hs
main = do cs <- getContents
putStr cs

Prelude> :set editor vim
Prelude> :edit somefile.txt

-- readfile01.hs
main = do
s <- readFile "somefile.txt"
-- let i = length s
-- putStrLn (show i)
putStrLn (show (length s))

-- count02.hs
count1 p xs = length $ filter p xs

-- =>
*Main> count1 odd [1..5]

-- count03.hs
count2 p xs = foldr (\x c -> if p x then c+1 else c) 0 xs

-- ->
*Main> count2 odd [1..5]
3

Prelude> (\x -> "hello, world") 3
"hello, world"
-- =>
Prelude> :t (\x -> "hello, world")
(\x -> "hello, world") :: t -> [Char]

-- Prelude> (\x -> x 'a') 3
-- error
Prelude> (\x -> x 'a') id
'a'
Prelude> :t (\x -> x 'a')
(\x -> x 'a') :: (Char -> t) -> t

-- Prelude> (\x -> x x) 3
-- error
-- Prelude> :t (\x -> x x)
-- error

Prelude> (\x -> x + x) 3
6
Prelude> :t (\x -> x + x)
(\x -> x + x) :: Num a => a -> a

*Main> data Pair a b = Pair a b
*Main> :t Pair
Pair :: a -> b -> Pair a b
*Main> :t Pair 'a'
Pair 'a' :: b -> Pair Char b
*Main> :t Pair 'a' "Hello"
Pair 'a' "Hello" :: Pair Char [Char]
*Main> let pairFst (Pair x y) = x
*Main> let pairSnd (Pair x y) = y
*Main> pairFst (Pair 'a' "Hello")
'a'
*Main> fst ('a', "Hello")
'a'

Prelude> data Triple a b c = Triple a b c

Prelude> let tripleFst (Triple x y z) = x
Prelude> let tripleSnd (Triple x y z) = y
Prelude> let tripleThrd (Triple x y z) = z
Prelude> tripleSnd (Triple 'A' 3 "Hello")
3

Prelude> :t Triple
Triple :: a -> b -> c -> Triple a b c

Prelude> data Quadruple a b = Quadruple a a b b
Prelude> :t (Quadruple 'a' 'b' 1 2)
(Quadruple 'a' 'b' 1 2) :: Num b => Quadruple Char b
Prelude> let firstTwo (Quadruple a b c d) = [a, b]
Prelude> let lastTwo (Quadruple a b c d) = [c, d]
Prelude> lastTwo (Quadruple 'a' 'b' 1 2)
[1,2]

-- prime01.hs
primes = filterPrime [2..]
where filterPrime (p:xs) =
p : filterPrime [x | x <- xs, x `mod` p /= 0]

-- =>
*Main> primes!!100
547

Prelude> putStrLn ['あ'..'お']
あぃいぅうぇえぉお
Prelude> length ['あ'..'お']
9
Prelude> import GHC.IO.Encoding
Prelude GHC.IO.Encoding> print =<< getLocaleEncoding
UTF-8
Prelude GHC.IO.Encoding> let sample1 :: IO (); sample1 = print =<< getLocaleEncoding
Prelude GHC.IO.Encoding> sample1
UTF-8

Prelude> let repeated f n = \x -> (iterate f x) !! n
Prelude> repeated (2+) 5 3
13

gosh> (map (lambda (x) (* x x)) '(1 2 3 4 5))
(1 4 9 16 25)
Prelude> map (\x -> (*) x x) [1..5]
[1,4,9,16,25]

Prelude> 1 + 2 — > 3
Prelude> 2 – 3 — > -1
Prelude> 2 * 3 — > 6
Prelude> 3 / 2 — > 1.5
Prelude> div 400 7 — > 57
Prelude> mod 10 3 — > 1
Prelude> 2 ^ 3 — > 8 — 巨大な数でも大丈夫
Prelude> 3 ** 0.5 — > 1.7320508075688772
Prelude> 3 == 3 — > True
Prelude> 3 /= 3 — > False
Prelude> 1 < 2 -- > True
Prelude> False || True — > True
Prelude> False && True — > False
Prelude> not True — > False
Prelude> pi — > 3.141592653589793
Prelude> sin (pi / 2) — > 1.0
Prelude> exp 1 — > 2.718281828459045
Prelude> log 10 — > 2.302585092994046
Prelude> sqrt 16 — > 4.0
Prelude> 27 ** (1 / 3) — > 3.0
Prelude> it — > 3.0 — 直前の数
Prelude> take 5 [1..] — > [1,2,3,4,5]
Prelude> [1..10] — > [1,2,3,4,5,6,7,8,9,10]
Prelude> head [1..10] — > 1
Prelude> tail [1..10] — > [2,3,4,5,6,7,8,9,10]
Prelude> drop 3 [1..10] — > [4,5,6,7,8,9,10]
Prelude> sum [1..10] — > 55
Prelude> let five = 2 + 3 in five — > 5
Prelude> let { sum’ = 0 ; sum’ (x:xs) = x + sum’ xs } in sum’ [1..10] — > 55
Prelude> let sum’ = 0 ; sum’ (x:xs) = x + sum’ xs in sum’ [1..10] — > 55
Prelude> let search xs t = length $ takeWhile (/= t) xs in search [1..10] 4 — > 3
Prelude> let fib = 1:1:zipWith (+) fib (tail fib) in take 10 fib — > [1,1,2,3,5,8,13,21,34,55] — フィボナッチ
Prelude> 1 – ( foldr (*) 1 [ (365-n)/365 | n<-[0..29] ] ) -- > 0.7063162427192686 — 誕生日の重なる確率
Prelude> let ar = reverse $ Data.List.sort [1,4,4] in head ar < (sum $ tail ar) -- > True 辺の長さ三角形判定
Prelude> sum [ 10 / n | n <- [1..10] ] -- > 29.289682539682538 — ランダム期待値
Prelude> fromEnum ‘A’ — > 65
Prelude> (toEnum :: Int -> Char) 65 — > ‘A’
Prelude> sum (map read (words “3 4 5.5″) :: [Float]) — > 12.5
Prelude System.IO> do { handle <- openFile "data.txt" ReadMode; contents <- hGetContents handle; print $ sum (map read (words contents)::[Float]); hClose handle } -- > data.txtの数字の合計

Prelude> show 3 — > “3” — 数字を文字列に変換
Prelude> read “3” :: Int — > 3 — 文字列を数字に変換(型指定必須)
Prelude> (read “3”:: Float) + 5.0 — > 8.0
Prelude Data.Ratio> 1 % 3 — > 1 % 3 — 分数(有理数)
Prelude Data.Ratio> 1 % 3 + 1 % 2 — > 5 % 6

*1:o-e)^2) / e | (o,e)<-zip os es]

rotate :: Int -> [a] -> [a]
rotate n xs = drop n xs ++ take n xs

crack :: String -> String
crack xs = encode (-factor) xs
where
factor = head (positions (minimum chitab) chitab)
chitab = [chisqr (rotate n table') table | n<-[0..25] ]
table' = freqs xs

Prelude> sum [x^2 | x<-[1..100]]
338350

Prelude> sum [x * y |(x,y) <- zip [1..100][1..100]]
338350

replicate :: Int -> a -> [a]
replicate n a = [a | x<-[1..n]]

Prelude> replicate 3 True
[True,True,True]

pyths :: Int -> [(Int,Int,Int)]
pyths n = [(x,y,z) | x<-[1..n], y<-[1..n], z<-[1..n], x^2+y^2==z^2]

Prelude> pyths 10
[(3,4,5),(4,3,5),(6,8,10),(8,6,10)]

Prelude> let factors n = [x | x <- [1..n], (mod n x) == 0]
Prelude> let perfects n = [ x | x<-[1..n], x == (sum (factors x

*2:o-e)^2) / e | (o,e)<-zip os es]

rotate :: Int -> [a] -> [a]
rotate n xs = drop n xs ++ take n xs

*Main> encode 3 "This is a pen."
"Wklv lv d shq."
*Main> crack "Wklv lv d shq."
"This is a pen."

factorial n = product [1..n]

factorial 0 = 1
factorial n = n * factorial (n-1)

product' :: Num a => [a] -> a
product' = 1
product' (n : ns) = n * product' ns

*Main> product' [1..5]
120

-- length01.hs

length' :: [a] -> Int
length' = 0
length' (_:xs) = 1 + length' xs

*Main> length' "This"
4

-- reverse01.hs

reverse' :: [a] -> [a]

reverse' =

reverse' (x:xs) = reverse' xs ++ [x]

*Main> reverse' [1,2,3]
[3,2,1]

-- plusplus01.hs

plusplus :: [a] -> [a] -> [a]
plusplus ys = ys
plusplus (x:xs) ys = x:(plusplus xs ys)

*Main> plusplus [1,2,3] [4,5]
[1,2,3,4,5]

-- plusplus02.hs

plusplus :: [a] -> [a] -> [a]
plusplus xs ys = foldr (:) ys xs

-- times01.hs

(*) :: [Int] -> [Int] -> [Int]
m * 0 = 0
m * (n + 1) = m + (m * n)

times01.hs:5:6: error: Parse error in pattern: n + 1
Failed, modules loaded: none.

-- times02.hs

times :: Int -> Int -> Int
times m 0 = 0
times m n = m + (times m (n -1) )

*Main> times 3 4
12

Prelude> sum [x^2 | x<-[1..100]]
338350

Prelude> sum [x * y |(x,y) <- zip [1..100][1..100]]
338350

-- insert01.hs
--
insert :: Ord a => a -> [a] -> [a]
insert x = [x]
insert x (y:ys) | x <= y = x:y:ys
| otherwise = y:insert x ys

*Main> insert 3 [1..5]
[1,2,3,3,4,5]

-- isort01.hs
isort :: Ord a => [a] -> [a]
isort =
isort (x:xs) = insert x (isort xs)

insert :: Ord a => a -> [a] -> [a]
insert x = [x]
insert x (y:ys) | x <= y = x:y:ys
| otherwise = y:insert x ys

*Main> isort [5,4,4,2,1,3]
[1,2,3,4,4,5]

-- zip01.hs

zip' :: [a] -> [b] -> [(a,b)]
zip' _ =
zip' _ =
zip' (x:xs) (y:ys) = (x, y) : zip' xs ys

*Main> zip' ['a', 'b', 'c'] [1,2,3,4]

[('a',1),('b',2),('c',3)]

-- drop01.hs
drop' :: Int -> [a] -> [a]
drop' 0 xs = xs
drop' n =
drop' n (_:xs) = drop' (n - 1) xs

*Main> drop' 3 [1..5]
[4,5]

-- fibonacci01.hs
fibonacci :: Int -> Int
fibonacci 0 = 0
fibonacci 1 = 1
fibonacci n = fibonacci(n - 1) + fibonacci(n - 2)

*Main> map fibonacci [0..5]
[0,1,1,2,3,5]

-- qsort01.hs
qsort :: Ord a => [a] -> [a]
qsort =
qsort (x:xs) = qsort smaller ++ [x] ++ qsort larger
where
smaller = [ a | a <- xs, a <= x]
larger = [ b | b <- xs, b > x]

*Main> qsort [4, 3 , 2 , 1, 5 , 8]
[1,2,3,4,5,8]

-- even01.hs
even' :: Int -> Bool
even' 0 = True
even' n = odd' (n - 1)
odd' :: Int -> Bool
odd' 0 = False
odd' n = even' (n - 1)

*Main> map even' [0..5]
[True,False,True,False,True,False]
*Main> map odd' [0..5]
[False,True,False,True,False,True]

-- evens01.hs
evens :: [a] -> [a]
evens =
evens (x:xs) = x:odds xs
odds :: [a] -> [a]
odds =
odds (_:xs) = evens xs

*Main> evens [1..5]
[1,3,5]
*Main> odds [1..5]
[2,4]

-- init01.hs
init' :: [a] -> [a]
init' [_] =
init' (x:xs) = x:init' xs

*Main> init' [1..5]
[1,2,3,4]
*Main> init' "abcdef"
"abcde"

-- power01.hs
power :: Int -> Int -> Int
power 0 _ = 0
power _ 0 = 1
power x n = x * power x (n - 1)

*Main> power 2 3
8

-- and01.hs
and' :: [Bool] -> Bool
and' [x] = x
and' (x:xs) = x && and' xs

*Main> and' [True, True]
True
*Main> and' [True, False,True]
False

-- concat01.hs
concat' :: [[a]] -> [a]
concat' =
concat' (x:xs) = x ++ concat' xs

*Main> concat' [["this"],["is"],["a"]]
["this","is","a"]

-- replicate01.hs
replicate' :: Int -> a -> [a]
replicate' 0 _ =
replicate' n a = [a] ++ replicate' (n - 1) a

*Main> replicate' 3 True
[True,True,True]

-- arrayelem01.hs
arrayelem :: Int -> [a] -> [a]
arrayelem 0 (x:xs) = [x]
arrayelem n (x:xs) = arrayelem (n - 1) xs

*Main> arrayelem 3 "this is a pen"
"s"
*Main> arrayelem 0 "this is a pen"
"t"

-- elem01.hs
elem' :: Eq a => a -> [a] -> Bool
elem' a = False
elem' a (x:xs) = a == x || elem a xs

*Main> elem' 'a' "This is a pen."
True

-- merge01.hs
merge :: Ord a => [a] -> [a] -> [a]
merge =
merge (x:xs) = x:xs
merge (y:ys) = y:ys
merge (x:xs) (y:ys) | x < y = x : merge xs (y:ys)
| otherwise = y : merge (x:xs) ys

*Main> merge [1,3,4][2,5]
[1,2,3,4,5]

-- msort01.hs
msort :: Ord a => [a] -> [a]
msort =
msort (x:) = [x]
msort xs = merge (msort a) (msort b)
where (a,b) = (halve xs)

-- halve01.hs
halve :: [a] -> ([a],[a])
halve xs = ((take n xs), (drop n xs

niming538's blog

Haskell千本ノック

mathjaxの実験

spanとかの実験

selectなど実験

色を選ぶ

ラジオボタンなど

formタグは使えるか

html編集ではstyleタグは使えません