Nuparu00

lyzpy

Oct 24th, 2021
889
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. ;;Lecture 2
  2.  
  3. ;;5
  4. (defun hypotenuse (x y) (sqrt (+ (* x x) (* y y))))
  5.  
  6. ;2
  7. (defun circle-area (r) (* pi r r))
  8.  
  9. (defun cone-volume (r h) (* 1/3 h (circle-area r)))
  10.  
  11. ;;7
  12. (defun signumb (x)
  13.   (if (> x 0) 1
  14.     (if (= x 0 ) 0 -1)))
  15.  
  16. ;;8
  17. (defun mini (x y)
  18.   (if (< x y) x y))
  19.  
  20. ;;9
  21. (defun maxi (x y)
  22.   (if (> x y) x y))
  23.  
  24. ;;10
  25. (defun coord-dst (A-x A-y B-x B-y)
  26.   (let ((x (- A-x B-x)) (y (- A-y B-y)))
  27.     (hypotenuse x y)))
  28.  
  29. ;;11
  30. (defun trianglep (a b c)
  31.   (and (tri-side-p a b c) (tri-side-p b c a) (tri-side-p c a b))
  32.   )
  33.  
  34. (defun tri-side-p (a b c)
  35.   (> (+ a b) c))
  36.  
  37. ;;12
  38. (defun heron (a b c)
  39.   (let ((s (/ (+ a b c) 2)))
  40.     (sqrt (* s (- s a) (- s b) (- s c)))))
  41. ;;13
  42. (defun heron-cart(A-x A-y B-x B-y C-x C-y)
  43.   (heron (point-dst A-x A-y B-x B-y) (point-dst B-x B-y C-x C-y) (point-dst C-x C-y A-x A-y)))
  44.  
  45.  
  46. ;;Lecture 3
  47.  
  48. ;;8
  49. (defun get-gcd (a b)
  50.   (if (= b 0) a (get-gcd b (mod a b))))
  51.  
  52. ;;13
  53. (defun digit-count (x) (digit-count-internal x 0))
  54.  
  55. (defun digit-count-internal (x count)
  56.        (if (< x 1) count (digit-count-internal (/ x 10) (+ count 1))))
  57.  
  58. ;;Returns the digit at Nth position from the right without using mod/rem, starts from 1
  59. (defun digit (x n)
  60.         (floor (* (- (/ x (power 10 n))
  61.             (floor (/ x (power 10 n))) ) 10)) )
  62.  
  63. ;;12
  64. (defun power (x n) (power-internal x n 1))
  65.  
  66. (defun power-internal (x n res) (if (> n  0) (power-internal x (- n 1) (* res x)) res))
  67.  
  68. (defun digit-sum (x) (digit-sum-internal x (digit-count x) 1 0))
  69.  
  70. (defun digit-sum-internal (x length pos sum)
  71.   (if (> pos length) sum (digit-sum-internal x length (+ pos 1) (+ sum (digit x pos)))))
  72.  
  73. ;;Uses digit-sum --> see 5 lines above
  74. (defun multiply-of-9-internal-p (x) (if (>= x 10) (multiply-of-9-internal-p (digit-sum x)) (= x 9) ))
  75.  
  76. (defun multiply-of-9-p (x) (multiply-of-9-internal-p (digit-sum x)))
  77.  
  78. ;;5
  79. (defun ellipse-area (a b) (if (eql b t) (ellipse-area a a) (* pi a b)))
  80.  
  81. ;;9
  82. (defun heron-sqrt (a x dif)
  83.   (if (<= (abs-delta (power x 2) a) dif) (* x 1.0)
  84.       (heron-sqrt a (/ (+ x (/ a x)) 2) dif)  
  85. ))
  86.  
  87. (defun abs-delta (a b)
  88.   (abs (- a b)))
  89.  
  90. ;;14
  91. (defun leibniz (deviation)
  92.   (leibniz-internal (/ deviation 10) 1 -1 3))
  93.  
  94. (defun leibniz-internal (deviation prev m n)
  95.   (let ((fraction (/ m n)))
  96.     (if (<= (abs fraction) deviation) (* 4.0 prev)
  97.       (leibniz-internal deviation (+ prev fraction) (- m) (+ 2 n))))))
  98. ;;10
  99. (defun range-sum-dumb (a b)
  100.   (if(> a b) 0
  101.     (if (= a b) a
  102.       (+ b (range-sum-dumb a (- b 1))))))
  103. ;;11
  104. (defun range-sum (a b)
  105.   (if (> a b) 0 (range-sum-internal a b a)))
  106.  
  107. (defun range-sum-internal (a b prev)
  108.   (if (= a b) prev (range-sum-internal a (- b 1) (+ prev b))))
  109.  
  110. ;;Lecture 4
  111.  
  112. (defun fib (n)
  113.   (fib-tr n 1 0))
  114.  
  115. (defun fib-tr (n next result)
  116.   (cond ((= n 0) result)
  117.         (t (fib-tr (- n 1) (+ next result) next))))
  118.  
  119. (defun power2 (n)
  120.   (* n n))
  121.  
  122. (defun fast-power (a n)
  123.   (fast-power-iter a n 1))
  124.        
  125. (defun fast-power-iter (a n ir)
  126.   (cond ((= n 0) ir)
  127.         ((evenp n)
  128.          (power2 (fast-power-iter a (/ n 2) ir)))
  129.         (t (fast-power-iter a (- n 1) (* a ir)))))
  130.  
  131. ;;Smaller first, larger second
  132. (defun dividesp (x y)
  133.   (= (mod y x) 0))
  134.  
  135. (defun remc (x y)
  136.   (- x (* y (truncate (/ x y)))))
  137.  
  138. (defun primep (x)
  139.   (prime-iter-p x (floor (/ x 2))))
  140.  
  141. (defun prime-iter-p (x check)
  142.   (or (<= check 1) (and (not (dividesp check x)) (prime-iter-p x (- check 1)))))
  143.  
  144. (defun perfectp (x)
  145.   (perfect-iter-p x (floor (/ x 2)) 0))
  146.  
  147. (defun perfect-iter-p (x check ir)
  148.   (or
  149.    (and (<= check 0) (= ir x))
  150.    (and (> check 0)
  151.         (if (dividesp check x)
  152.             (and (<= (+ check ir) x) (perfect-iter-p x (- check 1) (+ ir check)))
  153.           (perfect-iter-p x (- check 1) ir)))))
  154.  
  155. (defun pascal (row e)
  156.   (if (or (< e 0) (> e row) (and (= row 0) (not (= e 0))))
  157.       0
  158.     (if (= row 0) 1
  159.       (+ (pascal (- row 1) (- e 1)) (pascal (- row 1) e)))))
  160.  
  161. (defun fibbi (n)
  162.   (fibbi-iter n 0 1))
  163.  
  164. (defun fibbi-iter (n current next)
  165.   (if (<= n 0) current (fibbi-iter (- n 1) next (+ current next))))
  166.  
  167. ;;Lecture 5
  168.  
  169. (defun my-make-list (length elem)
  170.   (if (= length 0)
  171.       ()
  172.     (cons elem (my-make-list (- length 1) elem))))
  173.  
  174. (defun my-length (list)
  175.   (if list
  176.       (+ (my-length (cdr list)) 1) 0))
  177.  
  178. (defun point (x y)
  179.   (cons x y))
  180.  
  181. (defun point-x (pt)
  182.   (car pt))
  183. (defun point-y (pt)
  184.   (cdr pt))
  185.  
  186. (defun point-dst (A B)
  187.   (sqrt (+ (expt (- (point-x A) (point-x B)) 2)
  188.            (expt (- (point-y A) (point-y B)) 2))))
  189.  
  190. ;;1
  191. (defun right-triangle-p (A B C)
  192.   (let ((a-length (point-dst B C))
  193.         (b-length (point-dst A C))
  194.         (c-length (point-dst A B))) ;;Saves the lengths of the sides
  195.     (let ((hypo (max a-length b-length c-length)) ;;Max
  196.           (leg-a (max (min a-length b-length) (min (max a-length b-length) c-length))) ;;Mid
  197.           (leg-b (min a-length b-length c-length))) ;;Min
  198.       (= (+ (expt leg-a 2) (expt leg-b 2)) (expt hypo 2)))))
  199.  
  200. ;;2
  201.  
  202. (defun op-vertex (A B)
  203.   (point (+ (point-x B) (- (point-x B) (point-x A)))
  204.          (+ (point-y B) (- (point-y B) (point-y A)))))
  205.  
  206. ;;3/4
  207.  
  208. (defun fraction (n d)
  209.   (let ((div (gcd n d)) (neg (if (and (< n 0) (< d 0)) -1 1)))
  210.     (cons (* (/ n div) neg) (* (/ d div) neg))))
  211.  
  212. (defun numer (frac)
  213.   (car frac))
  214. (defun denom (frac)
  215.   (cdr frac))
  216.  
  217. (defun frac-+ (x y)
  218.   (fraction (+ (* (numer x) (denom y))
  219.                (* (numer y) (denom x)))
  220.             (* (denom x) (denom y))))
  221. (defun frac-* (x y)
  222.   (fraction (* (numer x) (numer y))
  223.             (* (denom x) (denom y))))
  224.  
  225. (defun frac-neg (x)
  226.   (fraction (* (numer x) -1)
  227.             (denom x)))
  228.  
  229. (defun frac-opp (x)
  230.   (fraction (denom x)
  231.             (numer x)))
  232.  
  233. (defun frac-- (x y) (frac-+ x (frac-neg y)))
  234.  
  235. (defun frac-/ (x y) (frac-* x (frac-opp y)))
  236.  
  237.  
  238. ;;5
  239. (defun interval (l u)
  240.   (cons l u))
  241.  
  242. (defun lower-bound (interval)
  243.   (car interval))
  244.  
  245. (defun upper-bound (interval)
  246.   (cdr interval))
  247.  
  248. (defun number-in-interval-p (n interval)
  249.   (and (>= n (lower-bound interval)) (<= n (upper-bound interval))))
  250.  
  251. (defun interval-intersection (a b)
  252.   (let ((l (max (lower-bound a) (lower-bound b))) (u (min (upper-bound a) (upper-bound b))))
  253.     (if (< u l) nil (interval l u))))
  254.  
  255. ;;6
  256. ;;(let ((end (cons 3 4))) (cons 1 (cons end (cons end 2))))
  257.  
  258. ;;7
  259.  
  260. (defun proper-list-p (list)
  261.   (if (not list) t (if (consp list) (proper-list-p (cdr list)) nil)))
  262. ;;8
  263. (defun my-make-list-iter (length elem)
  264.   (my-make-list-internal length elem ()))
  265.  
  266.  
  267. (defun my-make-list-internal (length elem prev)
  268.   (if (= length 0)
  269.       prev
  270.     (my-make-list-internal (- length 1) elem (cons elem prev))))
  271. ;;9
  272. (defun make-ar-seq-list (start d length)
  273.   (if (= length 0) () (cons start (make-ar-seq-list (+ start d) d (- length 1)))))
  274.  
  275. ;;10
  276. (defun make-ar-seq-list-iter (start d length)
  277.   (make-ar-seq-list-internal (+ start (* d (- length 1))) d length ()))
  278.  
  279. (defun make-ar-seq-list-internal (end d length prev)
  280.   (if (= length 0) prev
  281.     (make-ar-seq-list-internal (- end d) d (- length 1) (cons end prev))))
  282.  
  283. ;;11
  284.  
  285. (defun make-geom-seq-list (start q length)
  286.   (if (= length 0) () (cons start (make-geom-seq-list (* start q) q (- length 1)))))
  287.  
  288. ;;12
  289.  
  290. (defun make-geom-seq-list-iter (start q length)
  291.   (make-geom-seq-list-internal (* start (expt q (- length 1))) q length ()))
  292.  
  293. (defun make-geom-seq-list-internal (end q length prev)
  294.   (if (= length 0) prev
  295.     (make-geom-seq-list-internal (- end q) q (- length 1) (cons end prev))))
RAW Paste Data