Programmes Haskell

Tables de Laver

import List

type LD = [[Int]]

showLaver n = unlines $ map (unwords . map show) (genLaver n)

genLaver :: Int -> LD
genLaver n = l where
    l = reverse [
              let sx = (x+1) `mod` n
              -- Itération de *(x*1) à partir de (x*1)
                  lx = take n (iterate (\r -> (l!!r)!!sx) sx)
              in (last lx):(init lx) | x <- [n-1,n-2..0]]

period :: LD -> Maybe Int
period t = lookup 0 (zip (tail (t!!1)) [1..n-1]) where n = length t

main = do
  s <- getLine
  -- putStr . showLaver $ read s
  putStr "Period "
  putStr $ show $ period (genLaver (read s))

Approximations de √2

import List
import System.Environment

-- Naive method
un :: [Rational]
un = unfoldr (\x -> Just (x, (x+2)/(x+1))) 1

-- Newton's method
vn :: [Rational]
vn = unfoldr (\x -> Just (x, x/2+1/x)) 1

main = do
    argv <- getArgs           -- () -> IO [String]
    let s = read (head argv)  -- [String] -> Int
      in (putStrLn . show) (vn!!s)    -- Int -> IO String

Monades de polynômes

import Data.List
import Data.Monoid

-- The Semigroup Monad
data Semigroup a = Multiply [(a, Integer)]
toMonom l = Multiply l
fromMonom (Multiply l) = l

unit = Multiply []
(×) (Multiply x) (Multiply y) = Multiply (x++y)

power :: Semigroup a -> Integer -> Semigroup a
power (Multiply l) n = Multiply (map (\m@(x,k) -> (x,k*n)) l)

map_sg :: Semigroup a -> (a -> Semigroup b) -> Semigroup b
map_sg (Multiply x) f = foldr (×) unit l where 
    l = map (\t@(a,n) -> power (f a) n) x -- [(a,Int)] -> [Semigroup b]

instance Monad Semigroup where
    return x = Multiply [(x,1)]
    (>>=) = map_sg

-- The Ring Monad
data Ring a = Add [(Integer, Semigroup a)]

zero = Add []
plus (Add x) (Add y) = Add (x++y)
one = Add [(1, unit)]
times (Add x) y = foldr plus zero (map (\s -> simple_times s y) x)

pow x 0 = one
pow x n = times x (pow x (n-1))

simple_times :: (Integer, Semigroup a) -> Ring a -> Ring a
simple_times (n,x) (Add y) = Add (map (\s@(n2, x2) -> (n*n2, x × x2)) y)

multiply_them :: (Integer, Semigroup a) -> (a -> Ring b) -> Ring b
multiply_them (n, Multiply x) f = simple_times (n,unit) fx where
    l = map (\s@(t,n) -> pow (f t) n) x 
    fx = foldr times one l

map_ring :: Ring a -> (a -> Ring b) -> Ring b
map_ring (Add x) f = foldr plus zero l where 
    l = map (\s -> multiply_them s f) x

instance Monad Ring where
    return x = Add [(1, Multiply [(x,1)])]
    (>>=) = map_ring

main = return Nothing