vector.sld 2.1 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768
  1. (define-library (turtle vector)
  2. (import (scheme base)
  3. (scheme inexact))
  4. (export rotate vector-sum scale-vector negate-vector vector-magnitude
  5. vector-difference vector-distance unit-vector vector-dot-product
  6. degrees->radians radians->degrees vector-cross-product)
  7. (begin
  8. (define (rotate vec pvec theta-degs)
  9. (define theta (degrees->radians theta-degs))
  10. (vector-sum (scale-vector vec
  11. (cos theta))
  12. (scale-vector pvec
  13. (sin theta))))
  14. (define (vector-sum . vs)
  15. (list->vector (apply map + (map vector->list vs))))
  16. (define (vector-difference . vs)
  17. (if (null? (cdr vs))
  18. (negate-vector (car vs))
  19. (apply vector-sum
  20. (car vs)
  21. (map negate-vector (cdr vs)))))
  22. (define (vector-distance v1 v2)
  23. (vector-magnitude
  24. (vector-sum v1 (scale-vector v2 -1.0))))
  25. (define (scale-vector v k)
  26. (vector-map (lambda (x)
  27. (* x k))
  28. v))
  29. (define (negate-vector v)
  30. (scale-vector v -1))
  31. (define (unit-vector v)
  32. (scale-vector v (/ (vector-magnitude v))))
  33. (define pi (* 2 (acos 0)))
  34. (define (degrees->radians degs)
  35. (* degs (/ pi 180)))
  36. (define (radians->degrees rads)
  37. (/ rads (/ pi 180)))
  38. (define (vector-magnitude v)
  39. (sqrt (apply + (map square (vector->list v)))))
  40. (define (vector-dot-product . l)
  41. (apply + (vector->list (apply vector-map * l))))
  42. (define (vector-cross-product v1 v2)
  43. (define s0 (- (* (vector-ref v1 1)
  44. (vector-ref v2 2))
  45. (* (vector-ref v1 2)
  46. (vector-ref v2 1))))
  47. (define s1 (- (* (vector-ref v1 2)
  48. (vector-ref v2 0))
  49. (* (vector-ref v1 0)
  50. (vector-ref v2 2))))
  51. (define s2 (- (* (vector-ref v1 0)
  52. (vector-ref v2 1))
  53. (* (vector-ref v1 1)
  54. (vector-ref v2 0))))
  55. (vector s0 s1 s2))))