解方程组(形式上全为符号正的,能够半自动解答下面两组方程了)

解方程组(形式上全为符号正的,能够半自动解答下面两组方程了)

(setq material
'( (equtation (+ (* 2 a) (* 4 b) ) 20 )
(equtation (+ (* 3 a) (* 8 b) ) 40 )) )

(setq test '(equtation (+ (* 2 a) (* 4 b) ) 20 ) )
(setq testtwo '(equtation (+ (* 3 a) (* 8 b) ) 40 ) )

(B 5)(A 0)

(setq material
'( (equtation (+ (* 6 a) (* 7 b) ) 33 )
(equtation (+ (* 7 a) (* 8 b) ) 38 )) )

(setq test '(equtation (+ (* 6 a) (* 7 b) ) 33 ) )
(setq testtwo '(equtation (+ (* 7 a) (* 8 b) ) 38 ) )

(B 3) (A 2)

(defun simplehelperdivi (lst num)
(if (eq (print lst ) nil)
nil
(cond
( (or (eq (car lst) '-) (eq (car lst) '+) )
(cons (car lst)
(simplehelperdivi (cdr lst) num)))
( (eq (car lst) '*)
(list (car lst) (/ (cadr lst) num) (caddr lst)))
( (numberp (car lst) )
(cons (/ (car lst) num )
(simplehelperdivi (cdr lst) num)))
( (listp (car lst) )
(cons (simplehelperdivi (car lst) num )
(simplehelperdivi (cdr lst) num)))
(t (print 'over)))))

(defun simplehelper (lst)
(if (eq (car lst) '/)
(progn
(print lst)
( simplehelperdivi (cadr lst) (caddr lst) ))
(print 'error)))

(defun negative (lst)
(if (eq lst nil)
nil
(if (numberp (car lst) )
(cons (- 0 (car lst) ) nil)
(if (listp (car lst) )
(cons (negative (car lst) )
(negative (cdr lst)))
(if (eq (car (print lst )) '*)
(print (list (car lst) (- 0 (cadr lst) ) (caddr lst))))))))

(defun simple (lst env)
(if (eq (car lst) 'equtation)
(cond
( (eq (caadr lst) '+)
(progn
(print 'chenbing+)
( simple (list 'equtation
(cadadr lst)
(append (list '+ (caddr lst) )
(negative (cddadr lst))))
env ) ))
( (eq (caadr lst) '*)
(progn
(print 'chenbing*)
(print lst)
(cons
(append (list (caddr (cadr lst ))
(simplehelper (list '/ (caddr lst) (cadadr lst )))))
env)))
(t (print 'nothing)))
(print 'error)))

(defun look (let env)
(if (eq env nil)
let
(if (eq (caar env) let)
(cadar env)
(look let (cdr env)))))

(defun wrapprecalc (lst)
(list (car lst) (precalc (cadr lst) ) (caddr lst) ))

(if (listp (car left) )
(cons (emerge (car left) right)
(emerge (cdr left) right))

(defun emerge (left right )
(progn
(print 'start)
(print left)
(print right)
(if (eq left nil)
nil
(if (atom (car left) )
(cons (car left)
(emerge (cdr left) right))
(if (eq (caddar left) (caddr right) )
(cons (list (caar left)
(+ (cadar left) (cadr right))
(caddar left))
(emerge (cdr left) right))))))
)

(defun precalcmul (lst num)
(if (eq (print lst ) nil)
nil
(cond
( (or (eq (car lst) '-) (eq (car lst) '+) )
(cons (car lst)
(precalcmul (cdr lst) num)))
( (eq (car lst) '*)
(list (car lst) (* (cadr lst) num) (caddr lst)))
( (numberp (car lst) )
(cons (* (car lst) num )
(precalcmul (cdr lst) num)))
( (listp (car lst) )
(cons (precalcmul (car lst) num )
(precalcmul (cdr lst) num)))
(t (print 'over)))))

(defun wraporder (lst)
(list (car lst) (order (cadr lst) ) (caddr lst) ))

(defun order (lst)
(if (atom (cadr lst) )
(list (car lst) (caddr lst) (cadr lst) )
lst))

(defun precalc ( lst )
(cond
( (eq lst nil) nil)
( (and (or (eq (car lst) '+)(eq (car lst) '-) )
(not (atom (cadr lst)) )
(eq (caadr lst) '+))
(emerge (cadr lst) (caddr lst) ))
( (and (or (eq (car lst) '+)(eq (car lst) '-) )
(atom (cadr lst))
(atom (caddr lst)))
(+ (cadr lst) (caddr lst)))
( (or (eq (car lst) '+)(eq (car lst) '-) )
(cons (car lst)
(precalc (cdr lst))))
( (and (eq (car lst) '*) (listp (caddr lst) ) )
(precalcmul (caddr lst) (cadr lst) ))
( (listp (car lst) )
(progn
(print (car lst ))
(cons (precalc (car lst) )
(precalc (cdr lst )))))
(t lst)))

(defun substi ( lst env)
(if (or (eq lst nil) (eq env nil))
lst
(if (atom (car lst) )
(cons (look (car lst) env )
(substi (cdr lst) env))
(cons (substi (car lst) env )
(substi (cdr lst) env)))))

(defun eva ( lst env)
(if (eq lst nil)
(print env)
(progn
(print (car lst))
(print env)
(eva (cdr lst)
(simple (substi (car lst) env) env)))))

(defun strict (lst)
(cond
( (numberp lst) lst)
( ( eq (car lst) '+ )
(+ (strict (cadr lst))
(strict (caddr lst))))
( ( eq (car lst) '* )
(* (strict (cadr lst))
(strict (caddr lst))))))

(defun solve (env)
(if (eq env nil)
nil
(progn
(print env)
(print (caar env) )
(solve
(substi (cdr env )
(list (list (caar env)
(print (strict (cadar env))))))))))

(setq env (simple test nil))
(setq temp (substi testtwo env))
(setq temp2 (wrapprecalc temp))
(setq temp3 (wrapprecalc temp2))
(setq temp4 (wraporder temp3))

(setq env (simple temp4 env))

(setq result (solve env) )

(eva material nil)