/src/math/vector/source.scm

 1
 2;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 3;; vector
 4;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 5
 6(define (vector+ . args) (apply vector-map + args))
 7(define (vector- . args) (apply vector-map - args))
 8(define (vector* . args) (apply vector-map * args))
 9(define (vector/ . args) (apply vector-map / args))
10
11;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
12
13(define (vector*n v n) (vector-map (multiplier n) v))
14(define (vector/n v n) (vector-map (divide-by  n) v))
15
16;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
17
18(define (vector-sum v)
19
20  (let ((sum 0))
21
22    (let ((add-to-sum
23           (lambda (elt)
24             (set! sum (+ sum elt)))))
25
26      (vector-for-each add-to-sum v))
27
28    sum))
29
30;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
31
32(define (vector. a b) (vector-sum (vector* a b)))
33
34;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
35;; vec
36;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
37
38(define (vec+ . args) (vec-obj (apply vector+ (map (lambda (v) (-> v 'raw)) args))))
39(define (vec- . args) (vec-obj (apply vector- (map (lambda (v) (-> v 'raw)) args))))
40(define (vec* . args) (vec-obj (apply vector* (map (lambda (v) (-> v 'raw)) args))))
41(define (vec/ . args) (vec-obj (apply vector/ (map (lambda (v) (-> v 'raw)) args))))
42
43;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
44
45(define (vec*n v n) ((-> v 'map) (multiplier n)))
46(define (vec/n v n) ((-> v 'map) (divide-by  n)))
47
48;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
49
50;; (define (vec-norm v)
51;;   (sqrt (-> ((-> v 'map) sq) 'sum)))
52
53;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
54
55(define (v. a b)
56  (-> (vec* a b) 'sum))
57
58;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
59
60(define v+ vec+)
61(define v- vec-)
62
63(define v*n vec*n)
64(define v/n vec/n)
65
66
67
68;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
69
70(define (norm v)
71  (sqrt
72   (vector-sum
73    (vector-map sq (vector-ref v 1)))))
74
75(define (normalize v) (v/n v (norm v)))
76
77;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
78