Schw"achen: @sin @circ @arcsin wird nicht vereinfacht.
---------------------------------------------------------------------- > module Simplify ( standard1, standard2, standard3, > (...), summ, prod, (^^^), > reduce, compact, distribute, lower > ) > where ----------------------------------------------------------------------
---------------------------------------------------------------------- > import Support > > import Sort ( mergeSortBy, mergeLists ) > renaming (mergeSortBy to sortBy) > > import Function ( Function(..), Prim(..), constant, > summands, factors, esplit, > nat, zero, one, mone ) ----------------------------------------------------------------------
---------------------------------------------------------------------- > infixr 1 ... > infixr 5 ^^^, `pow` > infix 4 -=> ----------------------------------------------------------------------
---------------------------------------------------------------------- > fold (...) summ prod (^^^) = fold > where > fold (f :.: g) = fold f ... fold g > fold (Summ fs) = summ [ fold f | f<-fs ] > fold (Prod fs) = prod [ fold f | f<-fs ] > fold (f :^: g) = fold f ^^^ fold g > fold f = f ----------------------------------------------------------------------
Beachte: maximal 10 Iterationen.
---------------------------------------------------------------------- > simplify red = iterate red # take 10 # limit > > reduce = fold (...) summ prod (^^^) ----------------------------------------------------------------------
Komposition.
---------------------------------------------------------------------- > f ... Id = f > Ratio n ... f = Ratio n > Const c ... f = Const c > Id ... f = f > (f :.: g) ... h = f ... (g ... h) > (Summ fs) ... h = Summ [ f ... h | f<-fs ] > (Prod fs) ... h = Prod [ f ... h | f<-fs ] > (f :^: g) ... h = (f ... h) ^^^ (g ... h) > f ... g = f :.: g -- catch all ----------------------------------------------------------------------
Addition.
---------------------------------------------------------------------- > summ [] = zero > summ [f] = f > summ fs = Summ (peval (mergeLists [ summands f | f<-fs ])) > where > peval (Ratio m:Ratio n:fs) = peval (Ratio (m + n):fs) > peval fs = fs ----------------------------------------------------------------------
Multiplikation.
---------------------------------------------------------------------- > prod [] = one > prod [f] = f > prod fs > | zero `elem` gs = zero > | otherwise = Prod (peval gs) > where > gs = mergeLists [ factors f | f<-fs ] > peval (Ratio m:Ratio n:fs) = peval (Ratio (m * n):fs) > peval fs = fs ----------------------------------------------------------------------
Exponentiation.
---------------------------------------------------------------------- > Ratio m ^^^ Ratio (n :% 1) > | n >= 0 = Ratio (m ^ n) > | otherwise = Ratio (recip m ^ negate n) > --Ratio n ^^^ f | n == 0 = zero -- f > 0 !! > f ^^^ Ratio n | n == 0 = one -- f /= 0 ?? > Ratio n ^^^ f | n == 1 = one > f ^^^ Ratio n | n == 1 = f > (Prod fs) ^^^ h = prod [ f ^^^ h | f<-fs ] > (f :^: g) ^^^ h = f ^^^ prod [g, h] > f ^^^ g = f :^: g -- catch all ----------------------------------------------------------------------
---------------------------------------------------------------------- > compact :: Function -> Function > compact = fold (...) scompact pcompact (^^^) ----------------------------------------------------------------------
---------------------------------------------------------------------- > scompact = map fsplit # sortBy le2 # groupBy eq2 # map melt # summ > where > melt [] = zero > melt ((c, f):cfs) = prod [summ (c : [ c | (c, _)<-cfs ]), f] ----------------------------------------------------------------------
---------------------------------------------------------------------- > fsplit (Prod (m@(Ratio _):fs)) = (m, Prod fs) > fsplit f = (one, f) ----------------------------------------------------------------------
---------------------------------------------------------------------- > pcompact = map esplit # sortBy le1 # groupBy eq1 # map melt # prod > where > melt [] = one > melt ((b, e):bes) = b ^^^ summ (e : [ e | (_, e)<-bes ]) ----------------------------------------------------------------------
Beachte: es ist wichtig, da"s die Faktoren vereinfacht werden (`^^^' statt `:^:'), da anderenfalls `fsplit' nicht richtig arbeitet (das Muster `Prod (m@(Ratio _):fs)' pa"st nicht).
---------------------------------------------------------------------- > eq1 (a, _) (b, _) = a == b > le1 (a, _) (b, _) = a <= b > > eq2 (_, a) (_, b) = a == b > le2 (_, a) (_, b) = a <= b ----------------------------------------------------------------------
---------------------------------------------------------------------- > standard1 = simplify (reduce # compact) ----------------------------------------------------------------------
---------------------------------------------------------------------- > standard2 = simplify (reduce # compact # distribute) ----------------------------------------------------------------------
---------------------------------------------------------------------- > distribute = fold (...) summ mult (^^^) ----------------------------------------------------------------------
---------------------------------------------------------------------- > mult fs = Summ [ Prod gs | gs<-distr [ summands f | f<-fs ] ] ----------------------------------------------------------------------
---------------------------------------------------------------------- > distr [] = [[]] > distr (x:xs) = [ a:as | a<-x, as<-distr xs ] ----------------------------------------------------------------------
---------------------------------------------------------------------- > standard3 n = simplify (reduce # compact # lower n) ----------------------------------------------------------------------
---------------------------------------------------------------------- > lower n = fold (...) summ prod pow > where > (Summ (f:fs)) `pow` Ratio (i :% 1) > | i > 0 && i <= n = binom i f (Summ fs) > | i < 0 && -i <= n = binom (-i) f (Summ fs) ^^^ mone > f `pow` g = f ^^^ g -- catch all ----------------------------------------------------------------------
---------------------------------------------------------------------- > binom n f g = summ [ > prod [nat (c!(n,k)), f^^^nat k, g^^^nat (n-k)] > | k<-[0..n] ] > where c = array ((0,0),(n,n)) ( > [ (i,0) := 1 | i<-[0..n] ] > ++ [ (i,i) := 1 | i<-[1..n] ] > ++ [ (i,j) := c!(i-1,j) + c!(i-1,j-1) | i<-[2..n],j<-[1..i-1] ]) ----------------------------------------------------------------------
---------------------------------------------------------------------- > limit [] = error "Simplify.limit: empty list" > limit [a] = a > limit (a:x@(b:_)) > | a == b = a > | otherwise = limit x ----------------------------------------------------------------------
Go to the first, previous, next, last section, table of contents.