linear/linear-system.lisp

"Важный момент:
В виде списков чисел представлены три сущности:
1) Уравнения.
   Записаны как список коэфициентов при неизвестных.
   Равны нулю
2) Выражения.
   Записаны как список коэфициентов при неизвестный.
   Равны следующму неизвестному
3) Список значений неизвесных.
   В нём самой правой идёт единица - так сказать, неизвестное при свободном
   коэфициенте. Левее, следующий коэфициент.

То, какое число к какому неизвестному относится зависит только от его положения
в списке."

(defun list-mul (list num)
  "Умножаем все элементы списка на число"
  (if (null list)
      nil
      (cons (* (car list)
               num)
            (list-mul (cdr list)
                      num))))

(defun list-div (list num)
  "Делит все числа в списке на число"
  (list-mul list
            (/ 1 num)))

(defun list-sum (list-a list-b)
  "Складывает все "
  (mapcar '+
          list-a
          list-b))

(defun express-left-unknown (eqtn)
  "Выражает самое левое неизвестное через все остальные
На выходе получается список чисел. Он похож на запись уравнения,
но равен не нулю, а самому левому неизвестному"
  (list-div (cdr eqtn)
            (- (car eqtn))))

(defun replace-left-unknown (eqtn expr)
  "Принимает уравнение, выражение, которое выражает первую переменную на все
остальные, и заменяет первую переменную на это выражение)"
  (list-sum (cdr eqtn)
            (list-mul expr
                      (car eqtn))))

(defun replace-in-system (system expr)
  "Заменяет самую левую переменную во всей системе"
  (if (null system)
      nil
      (cons (replace-left-unknown (car system)
                                  expr)
            (replace-in-system (cdr system)
                               expr))))

(defun zero-eqtn? (eqtn)
  "Проверяет, что все числа в уравнении равны нулю"
  (apply '= 0 eqtn))

(defun inconsistent? (eqtn)
  "Проверяет, что в уравнении есть только один свободный
коэфициент, и он не равен нулю. Так как само уравнение должно быть равно нулю, это значит, что мы нашли противоречие."
  (cond  ((null eqtn)
          nil)

         ((and (null (cdr eqtn))
               (/= (car eqtn)
                   0))
          t)
         
         ((= (car eqtn)
             0)
          (inconsistent? (cdr eqtn)))

         (t
          nil)))

(defun forward (system expressions)
  "Принимаем систему уравнений, и проходимся по ней вперёд.
Выражаем левое неизвестное первого выражения через все остальные
и заменяем эту переменную на выражение во всех остальных уравнениях системы.
Выражения запоминаем в список expressions.
В результате, всё сокращается на одно неизвестное. Продолжаем до тех пор, пока
не кончатся все уравнения, либо пока не придём к противоречию.
Если уравнения кончатся, мы отдаём список выражений."
  (cond ((null system)
         expressions)
        
        ((zero-eqtn? (car system))
         (forward (cdr system)
                  expressions))
        
        ((inconsistent? (car system))
         (print "ОШИБКА! Система противоречива"))

        (t
         (let* ((eqtn (car system))
                (expr (express-left-unknown eqtn)))
            (forward (replace-in-system (cdr system)
                                        expr)
                     (cons expr
                           expressions))))))

(defun subst-vals (expr values)
  "Функция подставляет значения неизвестных в выражение, чтобы получить
следующее неивестное. Для этого он перемножает значения неизвестных на
коэфициенты при них (коэфициенты находятся в выражении)."
  (apply '+ (mapcar '*
                    expr
                    values)))

(defun go-back (exprs values-of-unknowns)
  (if (null exprs)
      values-of-unknowns
      (go-back (cdr exprs)
               (cons (subst-vals (car exprs)
                                 values-of-unknowns)
                     values-of-unknowns))))

(defun backward (expressions)
  "Получает список всех выражений, которые получились в результате
решения системы. Если последнее выражение содержит в себе только один коэфициент,
это значит, что это коэфициент при единице. Значит, система имеет решение.
Если в послежнем выражении несколько коэфициентов, значит, в системе бесконечно много
решений"
  (cond ((> (length (car expressions))
            1)
         (cons 'infinity
               expressions))

        (t
         (cons 'values-of-unknowns
               (go-back expressions
                        '(1))))))

(defun parse-equation (eq)
  (let ((coeffs (make-hash-table :test #'equal))
        (free 0)
        (current-coeff 1))
 
    (dolist (term eq)
      (cond
      
        ((eq term '=) 
         (setf current-coeff -1))
       
        ((eq term '*) nil)
        ((eq term '+) nil)
        ((eq term '-) 
         (setf current-coeff (- current-coeff)))
        
        ((numberp term)
         (if (eq (car (last (member term eq))) term)
             
             (setf free (* current-coeff term))
   
             (setf current-coeff (* current-coeff term))))
    
        (t 
         (setf (gethash term coeffs)
               (+ (or (gethash term coeffs) 0) current-coeff))
         (setf current-coeff 1))))

    (list coeffs free)))