add gaussian-elim

This commit is contained in:
mehbark 2023-01-15 19:41:29 -05:00
parent 514cb4139b
commit 52422563b1
2 changed files with 35 additions and 6 deletions

View file

@ -29,6 +29,24 @@
(defn gaussian-column (defn gaussian-column
[m col] [m col]
(cons {:mul-row col :by (/ 1 (at m col col))} (if (zero? (at m col col))
(for [y (range (inc col) (matrix-height m))] []
{:add-row col :times (- (at m col y)) :to-row y}))) (cons {:mul-row col :by (/ 1 (at m col col))}
(for [y (range (inc col) (matrix-height m))]
{:add-row col :times (- (at m col y)) :to-row y}))))
(defn gaussian-elim
"Takes a matrix and returns the steps to put in the form
[[1 a ... | sum1]
[0 1 ... | sum2]
...]
Assumes a lot of things lol"
([m]
(gaussian-elim m 0))
([m col]
(if (= col (matrix-height m))
[]
(let [steps (gaussian-column m col)
new (apply-all-at-once m steps)]
(concat steps (gaussian-elim new (inc col)))))))

View file

@ -72,8 +72,8 @@
"Apply a spec-compliant row-op to a matrix, curriable" "Apply a spec-compliant row-op to a matrix, curriable"
([op] ([op]
(fn [m] (fn [m]
(apply-row-op op m))) (apply-row-op m op)))
([op m] ([m op]
(if-let [[type inner] (opspec/conform op)] (if-let [[type inner] (opspec/conform op)]
(case type (case type
:swap (swap-rows :swap (swap-rows
@ -84,12 +84,23 @@
m m
(:times inner) (:times inner)
(:add-row inner) (:add-row inner)
(:to inner)) (:to-row inner))
:mul (mul-row :mul (mul-row
m m
(:by inner) (:by inner)
(:mul-row inner)))))) (:mul-row inner))))))
(defn apply-steps
[m steps]
(if (empty? steps)
[m]
(let [new (apply-row-op m (first steps))]
(cons new (apply-steps new (rest steps))))))
(defn apply-all-at-once
[m steps]
(last (apply-steps m steps)))
(defn at (defn at
"Returns the number at x y in a matrix" "Returns the number at x y in a matrix"
[m x y] [m x y]