2010
http://parametron.blogspot.com/2010/01/2010.html
リスト内包表記の練習みたいなコード
module Main where import Data.Char import Data.Function import Data.List import System.Environment data Term = Val Char | App Char Term Term ops4 :: [Char] ops4 = "+-*/" nums :: [Char] nums = "123456789" instance Show Term where show (Val c) = [c] show (App o l r) = "(" ++ show l ++ [o] ++ show r ++ ")" type Rat = (Int,Int) ctor :: Char -> Rat ctor x = (ord x - ord '0',1) ctoo :: Char -> (Rat -> Rat -> Rat) ctoo '+' (x,y) (z,w) = (x*w+z*y,y*w) ctoo '-' (x,y) (z,w) = (x*w-z*y,y*w) ctoo '*' (x,y) (z,w) = (x*z,y*w) ctoo '/' (x,y) (z,w) = if z == 0 then (0,0) else (x*w,y*z) main :: IO () main = mapM_ (putStrLn . show) . allterms nums . read . head =<< getArgs allterms :: [Char] -> Int -> [Term] allterms ds n = concat [ trees n ds os | os <- sequence (replicate (length ds - 1) ops4) ] trees :: Int -> [Char] -> [Char] -> [Term] trees n ds os = [ t | (_,rt@(r,t)) <- vtrees ds os, same n rt] same :: Int -> ((Rat,Term) -> Bool) same i ((n,d),_) = i*d == n && d /= 0 vtrees :: [Char] -> [Char] -> [([Char],(Rat,Term))] vtrees [c] os = [(os, (ctor c, Val c))] vtrees ds os = concat [ odtree os xs ys | (xs,ys) <- splits1 ds ] odtree :: [Char] -> [Char] -> [Char] -> [([Char],(Rat,Term))] odtree os ls rs = [ (os'', (ctoo o u v , t)) | (o:os',(u,l)) <- vtrees ls os , (os'' ,(v,r)) <- vtrees rs os' , let t = App o l r , norm t ] where norm (App o x (App o' y z)) = not (o `simop` o') norm _ = True mulp = (`elem` "*/") simop = (==) `on` mulp splits1 :: [a] -> [([a],[a])] splits1 [x] = [] splits1 (x:xs) = ([x],xs) : [ (x:ys,zs) | (ys,zs) <- splits1 xs ]