migration

clojure/linear.clj

@@ -0,0 +1,92 @@
+(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))