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 ]