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

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

(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)