comp.lang.lisp

William James

11/18/2015 3:30:00 PM

WJ wrote:

> Mark Tarver wrote:
>
> > The problem is to simplify symbolic expressions by applying the
> > following rewrite rules from the leaves up:
> >
> > rational n + rational m -> rational(n + m)
> > rational n * rational m -> rational(n * m)
> > symbol x -> symbol x
> > 0+f -> f
> > f+0 -> f
> > 0*f -> 0
> > f*0 -> 0
> > 1*f -> f
> > f*1 -> f
> > a+(b+c) -> (a+b)+c
> > a*(b*c) -> (a*b)*c
>
>
> > Language: OCaml
> > Author: Jon Harrop
> > Length: 15 lines
> >
> > let rec ( +: ) f g = match f, g with
> > | `Int n, `Int m -> `Int (n +/ m)
> > | `Int (Int 0), e | e, `Int (Int 0) -> e
> > | f, `Add(g, h) -> f +: g +: h
> > | f, g -> `Add(f, g)
> >
> >
> > let rec ( *: ) f g = match f, g with
> > | `Int n, `Int m -> `Int (n */ m)
> > | `Int (Int 0), e | e, `Int (Int 0) -> `Int (Int 0)
> > | `Int (Int 1), e | e, `Int (Int 1) -> e
> > | f, `Mul(g, h) -> f *: g *: h
> > | f, g -> `Mul(f, g)
> >
> >
> > let rec simplify = function
> > | `Int _ | `Var _ as f -> f
> > | `Add (f, g) -> simplify f +: simplify g
> > | `Mul (f, g) -> simplify f *: simplify g
>
>
> > Language: Lisp
> > Author: Andre Thieme
> > Length: 23 lines
> >
> > (defun simplify (a)
> > (if (atom a)
> > a
> > (destructuring-bind (op x y) a
> > (let* ((f (simplify x))
> > (g (simplify y))
> > (nf (numberp f))
> > (ng (numberp g))
> > (+? (eq '+ op))
> > (*? (eq '* op)))
> > (cond
> > ((and +? nf ng) (+ f g))
> > ((and +? nf (zerop f)) g)
> > ((and +? ng (zerop g)) f)
> > ((and (listp g) (eq op (first g)))
> > (destructuring-bind (op2 u v) g
> > (simplify `(,op (,op ,f ,u) ,v))))
> > ((and *? nf ng) (* f g))
> > ((and *? (or (and nf (zerop f))
> > (and ng (zerop g)))) 0)
> > ((and *? nf (= 1 f)) g)
> > ((and *? ng (= 1 g)) f)
> > (t `(,op ,f ,g)))))))
>
>
> (simplify '(* x (+ (+ (* 12 0) (+ 23 8)) y)))
> (* X (+ 31 Y))
>
>
>
> MatzLisp (Ruby)
> 8 lines
>
> def simplify((op, *args))
> return op if args.empty?
> args.map!{|u| simplify(u)}
> return args.reduce(op) if args.all?{|u| u.is_a? Numeric}
> return (op == :+ ? args[0] : 0) if args.delete 0
> return args[0] if (:* == op) && (args.delete 1)
> [op, *args]
> end
>
>
> simplify [:*, :x, [:+, [:+, [:*, 12, 0], [:+, 23, 8]], :y]]
> ==>[:*, :x, [:+, 31, :y]]
> simplify [:+,[:*,[:+,99,2],:x],[:+,0,:y]]
> ==>[:+, [:*, 101, :x], :y]
> simplify [:+,[:*,[:+,99,2],:x],[:*,0,:y]]
> ==>[:*, 101, :x]
> simplify [:+,[:*,[:+,99,2],:x],[:*,1,:y]]
> ==>[:+, [:*, 101, :x], :y]
>
>
> Faster:
>
> def simplify((op,a,b))
> return op unless a
> x,y = simplify(a),simplify(b)
> return (op == :+ ? x+y : x*y) if x.is_a?(Numeric) && y.is_a?(Numeric)
> only = (0==x) ? y : (0==y) ? x : nil
> return (op == :+ ? only : 0) if only
> return only if (op == :*) && (only = (1==x) ? y : (1==y) ? x : nil)
> [op,x,y]
> end

More capable:

def order((a,b))
if b.is_a? Numeric
[b,a]
elsif a.is_a? Array
[b,a]
else
[a,b]
end
end

def all_are(array,type)
array.all?{|x| x.is_a? type}
end

def both_ops(args,sym)
all_are(args,Array) && [sym,sym]==args.map(&:first)
end

def add(args)
if both_ops(args,:*)
muls = args.map{|xs| xs[1]}
if all_are(muls,Numeric)
vars = args.map(&:last).uniq
if vars.one?
[:*, muls.reduce(&:+), vars[0]]
end
end
end
end

def simplify((op, *args))
return op if args.empty?
args.map!{|u| simplify(u)}
return args.reduce(op) if all_are(args,Numeric)
return (op == :+ ? args[0] : 0) if args.delete 0
return args[0] if (:* == op) && (args.delete 1)
args = order(args)
if (op == :+) && both_ops(args, :+)
args = args.transpose.drop(1).map{|xs| simplify [:+, *xs]}
elsif (op == :+) && expr = add(args)
return expr
elsif (op == :+) && args.uniq.one?
op = :*
args = [2, args[0]]
end
expr = [op, *args]
last = expr.last
if last.is_a?(Array) && (op == last[0])
nums = [expr[1], last[1]]
if all_are(nums,Numeric)
expr = [op, nums.reduce(op), last.last]
end
end
expr
end

simplify [:+, [:*, 2, :x], [:*, 3, :x]]
==>[:*, 5, :x]
simplify [:+, [:+, 2, :x], [:+, 3, :y]]
==>[:+, 5, [:+, :y, :x]]
simplify [:*, :x, [:+, [:+, [:*, 12, 0], [:+, 23, 8]], :y]]
==>[:*, :x, [:+, 31, :y]]
simplify [:+,[:*,[:+,99,2],:x],[:+,0,:y]]
==>[:+, :y, [:*, 101, :x]]
simplify [:+,[:*,[:+,99,2],:x],[:*,0,:y]]
==>[:*, 101, :x]
simplify [:+,[:*,[:+,99,2],:x],[:*,1,:y]]
==>[:+, :y, [:*, 101, :x]]
simplify [:*, 2, [:*, :k, 5]]
==>[:*, 10, :k]
simplify [:*, 4, [:*, 3, [:+, :x, :x]]]
==>[:*, 24, :x]
simplify [:+, [:*, 4, [:*, 3, [:+, :x, :x]]], [:+, [:*,0,:z], :y]]
==>[:+, :y, [:*, 24, :x]]
simplify [:+, [:+, 2, :x], [:+, 3, :x]]
==>[:+, 5, [:*, 2, :x]]
simplify [:+, 500, [:+, 200, [:*,9, [:+, [:*, 2, :x], [:*, 3, :x]]]]]
==>[:+, 700, [:*, 45, :x]]

--
You have politicians saying that ... as many Africans as want to come into
Sweden should be able to come.... They've already said that everybody from
Syria can come to Sweden.... [T]hey are actually thinking of commandeering
people's vacation homes because they need more housing for immigrants.
--- Dr. Kevin MacDonald (http://lnrlive.com/tpc/tpc201...)