93 lines
3.4 KiB
Clojure
93 lines
3.4 KiB
Clojure
(defn scalar? [x] (number? x))
|
||
|
||
(defn v? [x]
|
||
(and (vector? x) (every? number? x)))
|
||
|
||
(defn m? [x]
|
||
(and (vector? x) (every? v? x)))
|
||
|
||
(defn- same-length? [& vs]
|
||
(apply = (map count vs)))
|
||
|
||
(defn- same-shape? [& ms]
|
||
(apply = (map (fn [m] (mapv count m)) ms)))
|
||
|
||
(defn- check [cond msg]
|
||
(assert cond msg))
|
||
|
||
(defn- vec-op [op & vs]
|
||
(check (every? v? vs) "Все аргументы должны быть векторами чисел")
|
||
(check (apply same-length? vs)
|
||
(str "Векторы должны быть одинаковой длины, получено: " (mapv count vs)))
|
||
(apply mapv op vs))
|
||
|
||
(def v+ (partial vec-op +))
|
||
(def v- (partial vec-op -))
|
||
(def v* (partial vec-op *))
|
||
(def vd (partial vec-op /))
|
||
|
||
(defn scalar [& vs]
|
||
(reduce + (apply v* vs)))
|
||
|
||
(defn vect
|
||
"Векторное произведение произвольного числа 3-мерных векторов."
|
||
[& vs]
|
||
(check (every? v? vs) "Все аргументы должны быть векторами")
|
||
(check (every? #(= 3 (count %)) vs)
|
||
"Векторное произведение определено только для 3-мерных векторов")
|
||
(reduce
|
||
(fn [a b]
|
||
(let [[a0 a1 a2] a
|
||
[b0 b1 b2] b]
|
||
[(- (* a1 b2) (* a2 b1))
|
||
(- (* a2 b0) (* a0 b2))
|
||
(- (* a0 b1) (* a1 b0))]))
|
||
vs))
|
||
|
||
(defn v*s [v & scalars]
|
||
(check (v? v) "Первый аргумент должен быть вектором")
|
||
(check (every? scalar? scalars) "Остальные аргументы должны быть скалярами")
|
||
(let [s (reduce * scalars)]
|
||
(mapv #(* % s) v)))
|
||
|
||
(defn- mat-op [op & ms]
|
||
(check (every? m? ms) "Все аргументы должны быть матрицами")
|
||
(check (apply same-shape? ms)
|
||
(str "Матрицы должны иметь одинаковую форму, получено: "
|
||
(mapv #(vector (count %) (count (first %))) ms)))
|
||
(apply mapv (fn [& rows] (apply vec-op op rows)) ms))
|
||
|
||
(def m+ (partial mat-op +))
|
||
(def m- (partial mat-op -))
|
||
(def m* (partial mat-op *))
|
||
(def md (partial mat-op /))
|
||
|
||
(defn m*s [m & scalars]
|
||
(check (m? m) "Первый аргумент должен быть матрицей")
|
||
(check (every? scalar? scalars) "Остальные аргументы должны быть скалярами")
|
||
(let [s (reduce * scalars)]
|
||
(mapv (fn [row] (mapv #(* % s) row)) m)))
|
||
|
||
(defn transpose [m]
|
||
(check (m? m) "Аргумент должен быть матрицей")
|
||
(apply mapv vector m))
|
||
|
||
(defn m*v [m v]
|
||
(check (m? m) "Первый аргумент должен быть матрицей")
|
||
(check (v? v) "Второй аргумент должен быть вектором")
|
||
(check (= (count (first m)) (count v))
|
||
(str "Число столбцов матрицы (" (count (first m))
|
||
") должно совпадать с длиной вектора (" (count v) ")"))
|
||
(mapv #(scalar % v) m))
|
||
|
||
(defn m*m [& ms]
|
||
(check (every? m? ms) "Все аргументы должны быть матрицами")
|
||
(reduce
|
||
(fn [a b]
|
||
(check (= (count (first a)) (count b))
|
||
(str "Число столбцов левой матрицы (" (count (first a))
|
||
") должно совпадать с числом строк правой (" (count b) ")"))
|
||
(let [bt (transpose b)]
|
||
(mapv (fn [row] (mapv #(scalar row %) bt)) a)))
|
||
ms))
|