Differences Between English-Spanish Pronunciation Part 2 - The Five Main Vowels

September 13th, 2019

This post is my notes from a more detailed write up from the "Mimic Method" which comes with visual and audio aids. This only contains information on monophthongs - details of diphthongs and triphthongs and will come in a future part in this series.

There are five vowel sounds, and the alphabetic letters are the same as their corresponding phonetic letter [a] [e] [i] [o] [u].

One of the main differences between the Spanish vowels and their English equivalents is that the Spanish vowels are "short and crisp." They do not glide/change to a different sound as you say them. If you put your lips/mouth in the correction position, hold them there, and then perform a voiced sound1, you will get the right sound without having to alter the initial articulation. This is in contrast to some English vowels, like the o in "no" which glides something like a "w" as you say it.

A - The tongue is low and center, lips unrounded. You need to draw your tongue/jaw lower than when you make the ah sound in English words (like pot)

E - The tongue is at middle height and forward, lips unrounded. Be careful not to glide it to a y as we do in many English words such as "hey" and "bay".

I - The tongue is high and forward, lips unrounded. It is pronounced like the e's in the English word see.

O - The tongue is back and center, lips rounded.2

U - The tongue is back and high, lips rounded. Once again make sure not to curl the lips while saying the vowel.

Common Gringo Mistakes:

1. Closing/reducing/changing vowels: A, O, E. Each of the five (lone) vowels sound the same no matter where they are located in a word. When a gringo says nada they may say nah-duh. But the correct pronunciation has the A vowel the same both before and after the d.

2. Gliding vowels. Vowels (by themselves) in Spanish are never diphthongs. They are short sounds with an articulation that remains constant.

3. Lip rounding of vowels. Don't have your o's and u's morph to w's, like they do in the English for the words "no" and "Sue".

  1. release air through your lungs while "vibrating" your throat, as one always does when making a vowel. []
  2. The lips being rounded is not all that important since the vowel is defined by the tongue position. You certainly shouldn't have your lips rounding as you say the word, as mentioned before with the word "no" []

Differences Between English-Spanish Pronunciation Part 1 - Differences in stops d k t p

September 5th, 2019

This is part 1 of a series that goes through all of the major differences of pronunciation between Spanish and English. It assumes the reader knows a little bit of knowledge of phonetic1 lingo and knows some very basic Spanish pronunciation - like that i is pronounced ee as in see and that ll is pronounced like an English y. To begin:

d and t:

In English, d and t are both stops2 that are created by placing the tongue on the alveolar ridge.3 In Spanish, d and t are also stops, but they have a less forceful explosion of air, and the tongue blocks the airflow by being placed on the upper teeth instead of on the alveolar ridge. Relatedly, the stops in Spanish are not aspirated as they are in English.4 So in English we say tea [thi] en español se dice ti [ti].

p and /k/ (k or hard c):

p and /k/ have the same oral articulation in Spanish as they do in English. The difference is that -once again- in Spanish there is the release of air at the end of the stops is gentle and the stops are not aspirated.

  1. If you know nothing about phonetics or the IPA system I recommend A Practical Introduction to Phonetics by Catford - The book contains a series of exercises that helps you learn how to make sounds found in languages/accents from all over the world []
  2. A stop is a consonant where the sound is created by blocking airflow and then releasing upon pressure build up. In English, p and b are stops that block airflow via the lips, while k,t, and d block airflow with the tongue. []
  3. If you don't know what the alveolar ridge is, take a minute to gain some anatomy awareness by slowly dragging your tongue from your top teeth up to the roof of your mouth back and forth. Do this a few times to get the feel for the shape of your mouth. Then start again from the top teeth. Just as you pass the gums you will find your tongue along a ridge like shape. This is the alveolar ridge. You can also find the alveolar ridge by silently thinking and mouthing the word dad while paying attention to where your tongue is. []
  4. Aspiration is when there is a pause between the explosion of the stop and the onset of the vibration of the following vowel. To test if you are aspirating your ti in Spanish, do the following exercise: rest your finger gently on your adam's apple and say the English Tea. Notice the delay between when you hear the T and when your throat starts vibrating for the vowel i. Now do the same for the Spanish ti. You should have no delay between the t and the i []

No hace falta que se lo diga

August 30th, 2019

I saw the sentence in the title of this post in my Spanish version of For Whom The Bell TollsPor quién doblan las campanas. It took me a minute to grok the meaning, since there are a few different grammar concepts packed into the sentence. Let's go over them.

1. Hace falta. If something "hace falta"'s , it literally makes a fault, which means it is necessary.

2. Decir is conjugated in the first person subjective.  The change in subject between the clauses connected with the "que" in the impersonal expression1

3. Se is used for various different reasons in Spanish. In this case, it is being used as an indirect object pronoun. One would use "le" for the singular third person/formal 2nd person, but since the direct object pronoun "lo" immediately follows, the le is converted to se.

Put those together and given the context, the translates to : "I don't need to tell it to you."

  1. This comes from the I in the acronym English speakers are generally taught (WEIRDO) which tells of the various cases where one uses the subjunctive in Spanish - Wishes, Emotions, Impersonal Expressions, Recommendations, Doubt/Denial, Ojalá []

Some (Guitar) Music Theory Review

August 28th, 2019

Western music is based on the major scale. To play the major scale, you need to start at some note and then do the following sequence: WWHWWWH. Each H represents half, which means you increase the frequency by one semitone, (i.e. 2 ^ (1/12), i.e. 1 fret on the guitar.) The W represents two semitones. When you start on a note1 , you can stay in the key of that note by following any rotation of the major scale sequence. The index of the major scale that you start with determines the mode you are in.2

Switching modes throughout a piece is not advised. It swaps the mood of the piece, and gives the sense you are changing your style mid performance. However, switching keys while staying in the same mode can add lots of variety to the music.

Plato suggests only playing in the Dorian and Phrygian.

  1. the root []
  2. WWHWWWH Ionian (C D E F G A B C)
    WHWWWHW Dorian (D E F G A B C D)
    HWWWHWW Phrygian (E F G A B C D E)
    WWWHWWH Lydian (F G A B C D E F)
    WWHWWHW Mixolydian (G A B C D E F G)
    WHWWHWW Aeolian (A B C D E F G A)
    HWWHWWW Locrian (B C D E F G A B)

    The notes listed to the right of the mode are the note sequences for that mode that have no flats or sharps. But a mode can start with any note.
    []

Picking Up The Guitar At Age 24

August 22nd, 2019

One of the gifts I would give my younger self, had I the ability to be my own father1, would be music lessons for a decent instrument. My childhood music career consisted of meeting once a week in school to play the recorder. The recorder sounds awful, and I had horrible instruction. So for my whole life I considered playing an instrument an activity I was not good at and did not enjoy.

But when I was living in Costa Rica, I had the good fortune to have a neighbor who had a guitar lying around. After borrowing his for a few months, I got my own, and I've been playing ever since. I oscillate between whether or not I consider the guitar a waste of time. Playing an instrument gives an enjoyable way to measure progress in your ability to be self disciplined. The meta learning skill that comes with practicing an instrument can be carried into other aspects of life. The drawback is that it is easy to sink _lots_ of time into the guitar. Today I skipped my daily Spanish lesson in order to jam on the guitar for an extra hour and a half.

  1. I have a lot of resentment towards my father for not making smarter decisions on my behalf while I was too young to make them myself. This is the tragedy that befalls ~every child in America. To be fair, I had it better than most. I was put in a decent private school and had a somewhat stable home life. Yet the curse of my decent education is that I am now wise enough to know how much I've missed out on. Or rather wise enough to know I am not wise enough to know how much I missed out on. But I have a lower bound, and that lower bound is higher than I'd like it to be.) []

Still alive

August 16th, 2019

I've taken a pause on going through SICP, and have instead been focusing on making arrangements to get out of the US. This involves earning a few more benjies, finding a lease in a little Spanish speaking town,1, and saying goodbye to friends and family.

I regret not blogging more frequently. Taking a few minutes to write down and reflect on current goals can go a long way, especially when you do it publicly and give opportunities for criticism. Going forward, I aim to write at least twice a week.

  1. I am making decent progress on my quest to end my ESLtardness. But getting one or two latina girlfriends would speed things up a tad. []

Ch 2.2 Hierarchical Data and the Closure Property

May 28th, 2019

Do you know every time I post these, I need to go through and put extra spaces in in between double parens to avoid my code turning into footnotes? Holy hell.

This is probably the first useful post to someone going through SICP using Common Lisp since it contains a little bit of code to draw your images from the end of the chapter to svg markup. Look at print-svg-header, draw-to-square-svg, and draw-line at the bottom to see the details.


;; 2.17

(defun last-pair (lst)
  (if (equal (cdr lst) nil)
      lst
      (last-pair (cdr lst))))

;; 2.18
(defun my-reverse (lst)
  (if (equal lst nil)
      nil
      (append (my-reverse (cdr lst)) (list (car lst)))))

;; 2.19

(defparameter *us-coins* (list 50 25 10 5 1))

(defun cc (amount coin-values)
  (defun no-more? (values) (null values))
  (defun except-first-denomination (values) (cdr values))
  (defun first-denomination (values) (car values))
  (cond ( (equal amount 0) 1)
	 ( (or (< amount 0) (no-more? coin-values)) 0)
	 (t
	  (+ (cc amount
		 (except-first-denomination coin-values))
	     (cc (- amount
		    (first-denomination coin-values))
		 coin-values)))))

;; 2.20

(defun same-parity (x &rest y)
  (let ( (parity (mod x 2)))
    (defun filter-parity (remaining)
      (cond
	((null remaining) nil)
	((equal (mod (car remaining) 2) parity)
	 (cons (car remaining) (filter-parity (cdr remaining))))
	(t (filter-parity (cdr remaining))))))
  (cons x (filter-parity y)))

;; 2.21

(defun square-list (items)
  (if (null items)
      nil
      (cons (square (car items)) (square-list (cdr items)))))

(defun square-list-two (items)
  (mapcar (lambda (x) (square x)) items))

;; 2.22
;; This would make the first element in the list nil, and would make the cons chain
;; look something like (nil (1 (4 (9 16)))) which is a malformed list.

;; 2.23

(defun for-each (f lst)
    (if (not (null lst)) (funcall f (car lst)))
    (if (null lst) nil (for-each f (cdr lst))))

;; Seems like a  better verison, but we do not have progn as a construct so far in the book.
(defun for-each-progn (f lst)
  (if (null lst)
      nil
      (progn (funcall f (car lst)) (for-each f (cdr lst)))))

;; 2.24 see picture

;; 2.25

;; (car (cdaddr '(1 3 (5 7) 9)))
;; (caar '((7)))
;; (cadadr ( cadadr (cadadr '(1 (2 (3 (4 (5 (6 7))))))))

;; 2.26

(defun twotwosix ()
  (let ( (x (list 1 2 3))
	(y (list 4 5 6)))
    (print (append x y)) ; (1 2 3 4 5 6)
    (print (cons x y))   ; ( (1 2 3) 4 5 6)
    (print (list x y)))) ; ( (1 2 3) (4 5 6))

;; 2.27

;; This was easy to do by looking at the simple solution of shallow-reverse.
(defun deep-reverse (lst)
  (cond
    ( (null lst) nil)
    ( (atom (car lst)) (append (deep-reverse (cdr lst)) (list (car lst))))
    (t (append (deep-reverse (cdr lst)) (list (deep-reverse (car lst)))))))

;; 2.28

;; flatten the list
(defun fringe (lst)
  (cond
    ( (null lst) nil)
    ( (atom (car lst)) (cons (car lst) (fringe (cdr lst))))
    (t (append (fringe (car lst)) (fringe (cdr lst))))))

;; 2.29

(defun make-mobile (left right) (list left right))
(defun left-branch (mobile)  (car mobile))
(defun right-branch (mobile) (cadr mobile))

(defun make-branch (length structure) (list length structure))
(defun branch-length (branch) (car branch))
(defun branch-structure (branch) (cadr branch))

(defun is-leaf-branch (branch) (atom (branch-structure branch)))

;; I wonder if I should not have these circular definitions of get-weight and total-weight.
;; But it seems very useful to separate the block structure for the is-balanced method.
(defun get-weight (branch)
  (if (is-leaf-branch branch)
      (branch-structure branch)
      (total-weight (branch-structure branch))))

(defun total-weight (mobile)
  (let ( (left (left-branch mobile))
	 (right (right-branch mobile)))
    (+ (get-weight left) (get-weight right))))

(defun is-balanced (mobile)
  (defun torque-of-branch (branch) (* (branch-length branch) (get-weight branch)))
  (defun is-just-a-weight (mobile) (atom mobile))
  (if (is-just-a-weight mobile)
      t
      (let ( (left (left-branch mobile))
	    (right (right-branch mobile)))
	(and
	 (equal (torque-of-branch left) (torque-of-branch right))
	 (is-balanced (branch-structure left))
	 (is-balanced (branch-structure right))))))

(make-mobile (make-branch 5 10) (make-branch 6 (make-mobile (make-branch 5 5) (make-branch 6 6))))
(make-mobile (make-branch 5 20) (make-branch 10 (make-mobile (make-branch 2 8) (make-branch 8 2))))

;; d) we would just need to change "cad" in branch-structure and right-branch to "cdr"

;; 2.30

(defun square-tree-direct (tree)
  (cond
    ( (null tree) nil)
    ( (atom tree) (square tree))
    (t (cons (square-tree-direct (car tree)) (square-tree-direct (cdr tree))))))

(defun square-tree (tree)
  (mapcar
   (lambda (element)
     (if (listp element)
	 (square-tree element)
	 (square element))) tree))

;; 2.31

(defun tree-map (f tree)
  (mapcar (lambda (element) (if (listp element) (tree-map f element) (funcall f element))) tree))

;; 2.32

;; To find the subsets of s, we append the first element of s to all the subsets of s minus
;; the first element.
(defun subsets (s)
  (if (null s)
      (list nil)
      (let ( (rest (subsets (cdr s))))
	(append rest (mapcar (lambda (ele) (append ele (list (car s)))) rest)))))

;; 2.33

(defun accumulate (op initial sequence)
  (if (null sequence)
      initial
      (funcall op
	       (car sequence)
	       (accumulate op initial (cdr sequence)))))

(defun my-map (f sequence)
  (accumulate  (lambda (x y) (cons (funcall f x) y)) nil sequence))

(defun my-append (seq1 seq2)
  (accumulate #'cons seq2 seq1))

(defun my-length (sequence)
  (accumulate (lambda (x y) (declare (ignore x)) (+ 1 y)) 0 sequence))

;; 2.34

(defun horner-eval (x-val coefficients)
  (accumulate (lambda (coefficient processed) (+ coefficient (* x-val processed))) 0 coefficients))

;; 2.35

(defun count-leaves-acc (tree)
  (accumulate #'+ 0
	      (mapcar (lambda (ele)
			(if (listp ele)
			    (count-leaves-acc ele)
			    1)) tree)))
;; 2.36

(defun accumulate-n (op init seqs)
  (if (null (car seqs))
      nil
      (cons (accumulate   op init (mapcar #'car seqs))
	    (accumulate-n op init (mapcar #'cdr seqs)))))

;; 2.37

;; I'm not sure how to get the equivilant map function found in scheme,
;; so I rewrote dot-product.

(defun dot-product (v w)
  (defun multiply-same-indices (v w)
    (cond
      ( (null v) nil)
      (t
       (cons (* (car v) (car w))
	     (multiply-same-indices (cdr v) (cdr w))))))
  (accumulate #'+ 0 (multiply-same-indices v w)))

(defun matrix-*-vector (m v)
  (mapcar (lambda  (w) (dot-product w v)) m))

(defun transpose (mat)
  (accumulate-n #'cons nil mat))

(defun matrix-*-matrix (m n)
  (let ( (cols (transpose n)))
    (mapcar (lambda (row) (matrix-*-vector cols row)) m)))

;; 2.38

(defun fold-right (op initial sequence) (accumulate op initial sequence))

(defun fold-left (op initial sequence)
  (defun iter (result rest)
    (if (null rest)
	result
	(iter (funcall op result (car rest))
	      (cdr rest))))
  (iter initial sequence))

;; (iter (list nil 1) (2 3))
;; (iter (list (list nil 1) 2) (3))
;; (iter (list (list (list nil 1) 2) 3))

;; (fold-right / 1 (list 1 2 3 ))     = 3/2
;; (fold-left / 1 (list 1 2 3 ))      = 1/6
;; (fold-right list nil (list 1 2 3)) = (1 (2 (3 nil)))
;; (fold-left list nil (list 1 2 3))  = ( ( (nil 1) 2) 3)

;; op must be communative and associative.

;; 2.39

(defun fold-right-reverse (sequence)
  (fold-right (lambda (x y) (append y (list x))) nil sequence))

(defun fold-left-reverse (sequence)
  (fold-left (lambda (x y) (cons y x)) nil sequence))

;; 2.40

(defun enumerate-interval (start finish)
  (defun iter (current)
    (if (> current finish)
	nil
	(cons current (iter (+ current 1)))))
  (iter start))

(defun flatmap (proc seq)
  (accumulate #'append nil (mapcar proc seq)))

(defun pair-sum (pair)
  (+ (car pair) (cadr pair)))

;; primep must be imported from chapter1
(defun prime-sump (pair)
  (primep (pair-sum pair)))

(defun make-pair-sum (pair)
  (list (car pair) (cadr pair) (pair-sum pair)))

(defun unique-pairs (n)
  (flatmap
   (lambda (i) (mapcar (lambda (j) (list j i)) (enumerate-interval 1 (- i 1))))
   (enumerate-interval 2 n)))

(defun prime-sum-pairs (n)
  (mapcar #'make-pair-sum (remove-if-not #'prime-sump (unique-pairs n))))

;; 2.41

;; (1 2 3 4)
;; (1

(defun unique-triplets (n)
    (flatmap (lambda (i) (mapcar (lambda (pair) (append pair (list i))) (unique-pairs (- i 1)))) (enumerate-interval 3 n)))

(defun unique-triplets-that-sum-to (n s)
  (defun triplet-sums-to-s (triplet) (equal (+ (car triplet) (cadr triplet) (caddr triplet)) s))
  (remove-if-not #'triplet-sums-to-s (unique-triplets n)))

;; 2.42

;; Each board is represented as a list of numbers 1-8 that represent the position of the queen
;; in that column.
(defun queens (board-size)
  (defun adjoin-position (new-row k rest-of-queens)
    (declare (ignore k))
    (cons new-row rest-of-queens))

  (defun safe? (k positions)
    (declare (ignore k))
    (defun safe?-helper (ascending-diag horiz descending-diag positions)
      (cond
	((null positions) t)
	((or (equal (car positions) ascending-diag)
	     (equal (car positions) horiz)
	     (equal (car positions) descending-diag)) nil)
	(t (safe?-helper (+ ascending-diag 1) horiz (- descending-diag 1) (cdr positions)))))
    (safe?-helper (+ 1 (car positions)) (car positions) (- (car positions) 1) (cdr positions)))

  (defun queen-cols (k)
    (if (equal k 0)
	(list nil)
	(remove-if-not
	 (lambda (positions) (safe? k positions))
	 (flatmap
	  (lambda (rest-of-queens)
	    (mapcar (lambda (new-row)
		      (adjoin-position new-row k rest-of-queens))
		    (enumerate-interval 1 board-size)))
	  (queen-cols (- k 1))))))
  (queen-cols board-size))

;; 2.43

;; Louis Reasoner's solution is much slower because his program now calls queens-col for every
;; new possible position of a queen, instead of considering every new possible position of a queen
;; for one recusrive call to queens-cols.
;; This makes the recursive relationship switch from
;; T(k) = T(k-1) + C
;; to
;; T(k) = board-size * T(k-1) + C
;; So if the previous time was T the new time will be ~board-size^T.

;; 2.44

;; TODO Implement

(defun flip-vert (painter)
  (transform-painter painter
		     (make-vect 0.0 1.0)
		     (make-vect 1.0 1.0)
		     (make-vect 0.0 0.0)))

(defun right-split (painter n)
  (if (equal n 0)
      painter
      (let ( (smaller (right-split painter (- n 1))))
	(beside painter (below smaller smaller)))))

(defun up-split (painter n)
  (if (equal n 0)
      painter
      (let ( (smaller (up-split painter (- n 1))))
	(below painter (beside smaller smaller)))))

(defun corner-split (painter n)
  (if (equal n 0)
      painter
      (let ( (up (up-split painter (- n 1)))
	    (right (right-split painter (- n 1))))
	(let ( (top-left (beside up up))
	      (bottom-right (below right right))
	      (corner (corner-split painter (- n 1))))
	  (beside (below painter top-left)
		  (below bottom-right corner))))))

(defun square-limit (painter n)
  (let ( (quarter (corner-split painter n)))
    (let ( (half (beside (flip-horiz quarter) quarter)))
      (below (flip-vert half) half))))

(defun square-of-four (tl tr bl br)
  (lambda (painter)
    (let ( (top (beside (funcall tl painter) (funcall tr painter)))
	  (bottom (beside (funcall bl painter) (funcall br painter))))
      (below bottom top))))

(defun flipped-pairs (painter)
  (funcall (square-of-four #'identity #'flip-vert #'identity #'flip-vert) painter))

;; 2.45

(defun split (direction combine-smaller)
  (defun split-func (painter n)
    (if (equal n 0)
	painter
	(let ( (smaller (split-func painter (- n 1))))
	  (funcall direction painter (funcall combine-smaller smaller smaller)))))
  #'split-func)

;; 2.46

(defun frame-coord-map (frame)
  (lambda (v)
    (add-vect
     (origin-frame frame)
     (add-vect (scale-vect (xcor-vect v)
			   (edge1-frame frame))
	       (scale-vect (ycor-vect v)
			   (edge2-frame frame))))))

(defun make-vect (x y)
  (cons x y))

(defun add-vect (v1 v2)
  (make-vect (+ (xcor-vect v1) (xcor-vect v2))
	     (+ (ycor-vect v1) (ycor-vect v2))))

(defun sub-vect (v1 v2)
  (make-vect (- (xcor-vect v1) (xcor-vect v2))
	     (- (ycor-vect v1) (ycor-vect v2))))

(defun xcor-vect (v) (car v))
(defun ycor-vect (v) (cdr v))

(defun scale-vect (s v)
  (make-vect (* s (xcor-vect v)) (* s (ycor-vect v))))

;; 2.47
(defun make-frame (origin edge1 edge2)
  (list origin edge1 edge2))

(defun origin-frame (frame) (car frame))

(defun edge1-frame (frame) (cadr frame))

(defun edge2-frame (frame) (caddr frame))

(defun make-frame-2 (origin edge1 edge2)
  (cons origin (cons edge1 edge2)))

(defun origin-frame-2 (frame) (car frame))

(defun edge1-frame-2 (frame) (cadr frame))

(defun edge2-frame-2 (frame) (cddr frame))

;; 2.48

(defun make-segment-two (start-segment end-segment) (cons start-segment end-segment))
(defun start-segment-two (segment) (car segment))
(defun end-segment-two (segment) (cdr segment))

;; 2.49

(defun segments->painter (segment-list)
    (lambda (frame)
      (for-each
       (lambda (segment)
	 (draw-line
	  (funcall (frame-coord-map frame) (start-segment segment))
	  (funcall (frame-coord-map frame) (end-segment segment))))
       segment-list)))

;; a
(defun draw-outline ()
  (segments->painter
   (list
    (make-segment (make-vect 0 0) (make-vect 0 1))
    (make-segment (make-vect 0 1) (make-vect 1 1))
    (make-segment (make-vect 1 1) (make-vect 1 0))
    (make-segment (make-vect 1 0) (make-vect 0 0)))))

;; b

(defun draw-x ()
  (segments->painter
   (list
    (make-segment (make-vect 0 0) (make-vect 1 1))
    (make-segment (make-vect 0 1) (make-vect 1 0)))))

;; c

(defun draw-diamond ()
  (segments->painter
   (list
    (make-segment (make-vect .5 0) (make-vect 1 .5))
    (make-segment (make-vect 1 .5) (make-vect .5 1))
    (make-segment (make-vect .5 1) (make-vect 0 .5))
    (make-segment (make-vect 0 .5) (make-vect .5 0)))))

;; d

(defun draw-wave  ()
  (segments->painter
   ;; note that left = left of screen, not left of body. same with right.
   (list
    (make-segment (make-vect .3 0)    (make-vect .35 .5)) ;; start with bottom left leg
    (make-segment (make-vect .35 .5)  (make-vect .31 .55)) ;; to armpit
    (make-segment (make-vect .31 .55) (make-vect  .2  .44)) ;; bottom left elbow
    (make-segment (make-vect .2  .44) (make-vect   0 .6)) ;; to end of left hand
    (make-segment (make-vect  0   .8) (make-vect  .19 .58)) ;; top of left hand to weenus
    (make-segment (make-vect .19 .58) (make-vect .31 .62)) ;; weenus to left shoulder
    (make-segment (make-vect .31 .62) (make-vect .4  .62)) ;; left shoulder to bottom of head
    (make-segment (make-vect .4  .62) (make-vect .33 .8)) ;; bottom of head to left ear
    (make-segment (make-vect .33 .8)  (make-vect .4   1)) ;; left ear to top left head
    (make-segment (make-vect .6 1)    (make-vect .67 .8)) ;; top right head to top right ear
    (make-segment (make-vect .67 .8)  (make-vect .6 .62)) ;; top right ear to bottom of head
    (make-segment (make-vect .6 .62)  (make-vect .78 .62)) ;; bottom of head to right shoulder
    (make-segment (make-vect .78 .62) (make-vect 1 .3)) ;; right shouldre to top of right hand
    (make-segment (make-vect 1 .15)   (make-vect .61 .46)) ;; bottom right of hand to right armpit
    (make-segment (make-vect .61 .46) (make-vect .77 0)) ;; right armpit to right of right leg
    (make-segment (make-vect .6 0)  (make-vect .5 .28)) ;; left of right leg to penis
    (make-segment (make-vect .5 .28) (make-vect .4 0)) ;; penis to right of left leg.
    )))

;; 2.50

(defun transform-painter (painter origin corner1 corner2)
  (lambda (frame)
    (let ( (m (frame-coord-map frame)))
      (let ( (new-origin (funcall m origin)))
	(funcall painter
		 (make-frame new-origin
			     (sub-vect (funcall m corner1) new-origin)
			     (sub-vect (funcall m corner2) new-origin)))))))

(defun flip-horiz (painter)
  (transform-painter painter
		     (make-vect 1.0 0)
		     (make-vect 0.0 0.0)
		     (make-vect 1.0 1.0)))

(defun rotate90 (painter)
  (transform-painter painter
		   (make-vect 1.0 0.0)
		   (make-vect 1.0 1.0)
		   (make-vect 0.0 0.0)))

(defun rotate180 (painter)
  (rotate90 (rotate90 painter)))

(defun rotate270 (painter)
  (rotate90 (rotate180 painter)))

;; 2.51

(defun beside (painter1 painter2)
  (let ( (split-point (make-vect 0.5 0.0)))
    (let ( (paint-left
	   (transform-painter painter1
			      (make-vect 0.0 0.0)
			      split-point
			      (make-vect 0.0 1.0)))
	  (paint-right
	   (transform-painter painter2
			      split-point
			      (make-vect 1.0 0.0)
			      (make-vect 0.5 1.0))))
      (lambda (frame)
	(funcall paint-left frame)
	(funcall paint-right frame)))))

(defun below (painter1 painter2)
  (let ( (split-point (make-vect 0.0 .5)))
    (let ( (paint-bottom
	   (transform-painter painter1
			      (make-vect 0 0)
			      (make-vect 1.0 0)
			      split-point))
	  (paint-top
	   (transform-painter painter2
			      split-point
			      (make-vect 1.0 .5)
			      (make-vect 0.0 1.0))))
      (lambda (frame)
	(funcall paint-bottom frame)
	(funcall paint-top frame)))))

(defun below-rotate (painter1 painter2)
  (rotate90 (beside (rotate270 painter1) (rotate270 painter2))))

;; 2.52

;; Maybe we draw
;;

;; extra code to draw

;; a
(defun draw-wave-with-smile  ()
  (segments->painter
   ;; note that left = left of screen, not left of body. same with right.
   (list
    (make-segment (make-vect .3 0)    (make-vect .35 .5)) ;; start with bottom left leg
    (make-segment (make-vect .35 .5)  (make-vect .31 .55)) ;; to armpit
    (make-segment (make-vect .31 .55) (make-vect  .2  .44)) ;; bottom left elbow
    (make-segment (make-vect .2  .44) (make-vect   0 .6)) ;; to end of left hand
    (make-segment (make-vect  0   .8) (make-vect  .19 .58)) ;; top of left hand to weenus
    (make-segment (make-vect .19 .58) (make-vect .31 .62)) ;; weenus to left shoulder
    (make-segment (make-vect .31 .62) (make-vect .4  .62)) ;; left shoulder to bottom of head
    (make-segment (make-vect .4  .62) (make-vect .33 .8)) ;; bottom of head to left ear
    (make-segment (make-vect .33 .8)  (make-vect .4   1)) ;; left ear to top left head

    ;; smile

    (make-segment (make-vect .37 .75) (make-vect .5 .65))
    (make-segment (make-vect .5 .65)  (make-vect .63 .75))

    (make-segment (make-vect .6 1)    (make-vect .67 .8)) ;; top right head to top right ear
    (make-segment (make-vect .67 .8)  (make-vect .6 .62)) ;; top right ear to bottom of head
    (make-segment (make-vect .6 .62)  (make-vect .78 .62)) ;; bottom of head to right shoulder
    (make-segment (make-vect .78 .62) (make-vect 1 .3)) ;; right shouldre to top of right hand
    (make-segment (make-vect 1 .15)   (make-vect .61 .46)) ;; bottom right of hand to right armpit
    (make-segment (make-vect .61 .46) (make-vect .77 0)) ;; right armpit to right of right leg
    (make-segment (make-vect .6 0)  (make-vect .5 .28)) ;; left of right leg to penis
    (make-segment (make-vect .5 .28) (make-vect .4 0)) ;; penis to right of left leg.
    )))

;; b

(defun new-corner-split (painter n)
  (if (equal n 0)
      painter
      (let ( (up (up-split painter (- n 1)))
	    (right (right-split painter (- n 1))))
	(let ( (top-left up)
	      (bottom-right right)
	      (corner (corner-split painter (- n 1))))
	  (beside (below painter top-left)
		  (below bottom-right corner))))))

;; c

(defun outward-square-limit (painter n)
  (let ( (quarter (corner-split (flip-horiz painter) n)))
    (let ( (half (beside (flip-horiz quarter) quarter)))
      (below (flip-vert half) half))))

(defmacro print-svg-header (width height &body body)
  ;; I have the intuition that there is a proper way to do this without the use of progn.
  `(progn
     (format 't "<svg width=\"~a\" height=\"~a\" version=\"1.1\" xlmns=\"http://www.w3.org/2000/svg\">" ,width ,height)
     ,@body
     (format 't "</svg>")))

;; This perhaps should just be a function, and not a macro.
(defun draw-to-square-svg (painter &optional (width 500) (height 500))
  (print-svg-header width height
    (funcall painter
	      (make-frame (make-vect 0 height) (make-vect width 0) (make-vect 0 (- height))))))

(defun draw-line (start end)
  (format 't "<line x1=\"~a\" y1=\"~a\" x2=\"~a\" y2=\"~a\" stroke=\"black\" stroke-width=\"5\"/>"
	  (xcor-vect start)
	  (ycor-vect start)
	  (xcor-vect end)
	  (ycor-vect end)))

Nightmare

May 18th, 2019

Vivid dreams are one of the most beautiful aspects of living. I go to sleep every night1 knowing that I have a chance to have an experience akin to an acid trip.

This is not my first nightmare since I started _actually_ dreaming. But it had one moment that was so creepy and disturbing that it surpassed the realm of fear into the realm of beauty and awe.

The nightmare was long and involved, and I don't quite remember the storyline. What I do remember was there was some conflict between two groups of two people, and one person from one group set out to kill one from the other. The victim was sitting in a parked car, on a dark street near my high school. He was not paying attention, when all of the sudden his brains were blown out by a bullet that went through the driver's seat window.

My perspective was from ~5 meters outside the car looking into the driver's seat window at my friend. The bullet had gone straight through the center, leaving the pane of glass intact. But it was difficult to see my dead buddy, since the window had lost most of its transparency due to the cracks branching in all directions from the bullet hole.

The image of my dead friend through the cracked window then slowly began to morph. The window started slowly swirling counter clockwise, turning into a large eyeball as it spiraled. The bullet hole became the pupil, the white cracks the sclera. And the blood from my friend became red veins going every which way.

After a few seconds of morphing, the image froze on the completed transformation. The large eyeball stared at me in all of its magnificent horror.

  1. To do this I gave up smoking weed and started writing down my dreams []

SICP 2.1 Solutions - Introduction to Data Abstraction

May 17th, 2019

The chapters seem to get progressively harder, so I plan to break my future posts into subchapters like this one. So far no problem has proven itself to be particularly difficult, save 1.15 and 2.16. 1.15 requires reviewing how to solve runtimes for recursive solutions, which is only slightly touched on in the book. 2.16 is a whole project in and of itself, so I've chosen to skip that problem for now.

 
;; Functions needed from Chapter 1.
(defun average (a b) (/ (+ a b) 2))

;; 2.1
(defun make-rat (a b)
  (defun negate (x) (- x))
  (if (< b 0)
      (cons (negate a) (negate b))
      (cons a b)))

;; 2.2

(defun make-point (x y) (cons x y))
(defun x-point (point) (car point))
(defun y-point (point) (cdr point))
(defun make-segment (a b) (cons a b))
(defun start-segment (segment) (car segment))
(defun end-segment   (segment) (cdr segment))
(defun midpoint-segment (segment)
  (defun average-two-points (get-point)
    (average (funcall get-point (start-segment segment))
	     (funcall get-point (end-segment   segment))))
  (make-point
   (average-two-points #'x-point)
   (average-two-points #'y-point)))

(defun print-point (point)
  (princ "(")
  (princ (x-point point))
  (princ ", ")
  (princ (y-point point))
  (princ ")")
  nil)

;; 2.3

(defun square (x) (* x x))
(defun distance (p1 p2)
  (sqrt (+ (square (- (x-point p1) (x-point p2)))
	   (square (- (y-point p1) (y-point p2))))))
(defun length-segment (segment)
  (distance (start-segment segment) (end-segment segment)))

;; Rectangle Abstraction 1
;; Requires user to give p1 p2 p3 so <(p1 p2 p3) = pi/2
(defun make-rectangle (p1 p2 p3)
  (cons (make-segment p1 p2) (make-segment p2 p3)))
(defun width  (rectangle) (length-segment (car rectangle)))
(defun height (rectangle) (length-segment (cdr rectangle)))

(defun make-rectangle-2 (bottom-left width height)
  (cons bottom-left (cons width height)))
(defun width-2  (rectangle) (cadr rectangle))
(defun height-2 (rectangle) (cddr rectangle))

;; End Rectangle Abstraction
(defun perimeter (rectangle) (* 2 (+ (width rectangle) (height rectangle))))
(defun area (rectangle) (* (width rectangle) (height rectangle)))

;; 2.4
(defun mycons (x y)
  (lambda (m) (funcall m x y)))

(defun mycar (z)
  (funcall z (lambda (p q) (declare (ignore q)) p)))

(defun mycdr (z)
  (funcall z (lambda (p q) (declare (ignore p)) q)))

;; Substitution Model, same for mycdr
;; (mycar (mycons 1 2))
;; (funcall (mycons 1 2) (lambda (p q) (declare ignore q) p))
;; (funcall (lambda (m) (funcall m 1 2)) (lambda (p q) (declare ignore q) p))
;; (funcall (lambda (p q) (declare ignore q) p) 1 2)
;; ( (declare ignore 2) 1)
;; 1

;; 2.5

(defun num-cons (x y) (* (expt 2 x) (expt 3 y)))

(defun num-car (z)
  (if (equal (mod z 2) 1)
      0
      (+ 1 (num-car (/ z 2)))))

(defun num-cdr (z)
  (if (not (equal (mod z 3) 0))
      0
      (+ 1 (num-cdr (/ z 3)))))

;; 2.6

(defun church-zero () (lambda (f) (declare (ignore f)) (lambda (x) x)))

(defun church-add-one (n)
  (lambda (f) (lambda (x) (funcall f (funcall (funcall n f) x)))))

;; Substitution method
(lambda (f) (lambda (x) (funcall f (funcall (funcall (my-zero) f) x))))

(lambda (f)
  (lambda (x)
    (funcall f
	     (funcall
	      (funcall (lambda (f) (declare (ignore f)) (lambda (x) x)) f) x))))

(lambda (f)
  (lambda (x)
    (funcall
     f
     (funcall (lambda (x) x) x))))

(lambda (f)
  (lambda (x)
    (funcall f x)))

(defun church-one ()
  (lambda (f) (lambda (x) (funcall f x))))

;; add one to church-one to get church-two

(lambda (f)
  (lambda (x)
    (funcall
     f
     (funcall (funcall (lambda (f) (lambda (x) (funcall f x))) f) x))))

(lambda (f)
  (lambda (x)
    (funcall
     f
     (funcall (lambda (x) (funcall f x)) x))))

(defun church-two ()
  (lambda (f) (lambda (x) (funcall f (funcall f x)))))

;; church zero returns a function that takes a function f,
;; and returns an identity function. It does nothing with f.

;; church one returns a function that takes a function f, and then creates a
;; new function that takes a function x and calls f on x.

;; church two returns a function that takes a function f, and then creates a
;; new function that takes a function x, and calls f twice on x.

;; church two, takes a function f, returns a function that calls f on a
;;
(defun church-add (a b)
  (lambda (f) (lambda (x) (funcall (funcall a f) (funcall (funcall b f) x)))))

;; example

(church-add #'church-one #'church-zero)

(lambda (f)
  (lambda (x)
    (funcall
     (funcall (church-one) f)
     (funcall (funcall (church-zero) f) x))))

(lambda (f)
  (lambda (x)
    (funcall
     (funcall (church-one) f)
     (funcall (lambda (x) x) x))))

(lambda (f)
  (lambda (x)
    (funcall
     (funcall (church-one) f)
     x)))

(lambda (f)
  (lambda (x)
    (funcall
     (lambda (x) (funcall f x))
     x)))

(lambda (f) (lambda (x) (funcall f x)))

;; 2.7

(defun make-interval (a b) (cons a b))

(defun lower-bound (interval) (car interval))
(defun upper-bound (interval) (cdr interval))

;; 2.8

(defun add-interval (x y)
  (make-interval (+ (lower-bound x) (lower-bound y))
		 (+ (upper-bound x) (upper-bound y))))

(defun sub-interval (x y)
  (make-interval (- (lower-bound x) (upper-bound y))
		 (- (upper-bound x) (lower-bound y))))

;; 2.9

;; width =  (upper-bound - lower-bound)/2
;; addition:
;; 2w1 = u1 - l1
;; 2w2 = u2 - l2
;; 2w3 = (u1 + u2) - (l1 + l2)
;; 2w3 = (u1 - l1) + (u2 - l2)
;; w3 = w1 + w2

;; subtraction:
;; 2w1 = u1 - l1
;; 2w2 = u2 - l2
;; 2w3 = (u1 - l2) - (l1 - u2)
;; 2w3 = (u1 - l1) + (u2 - l2)
;; w3 = w1 + w2

;; multiplication counterexample:
;; i1 = -5 5
;; i2 =  5 10
;; i3 =  -5 0
;; i2 and i3 have the same width, but:
;; width of i1 * i2 (-50, 50) = 100
;; width of i1 * i3 (-25, 25) = 50

;; division counterexample:
;; i1 = 1 3
;; i2 = 1 3
;; i3 = -1 1
;; width of i1 / i2 (1/3, 3) = 10/3
;; width of i1 / i3 (-3, 3)  = 6

;; 2.10

(defun mul-interval (x y)
       (let ( (p1 (* (lower-bound x) (lower-bound y)))
	     (p2 (* (lower-bound x) (upper-bound y)))
	     (p3 (* (upper-bound x) (lower-bound y)))
	     (p4 (* (upper-bound x) (upper-bound y))))
	 (make-interval (min p1 p2 p3 p4) (max p1 p2 p3 p4))))

(defun div-interval-fixed (x y)
  (if (or (equal x 0) (equal y 0))
      (error "Division by zero")
      (mul-interval
       x
       (make-interval (/ 1.0 (upper-bound y))
		      (/ 1.0 (lower-bound y))))))

;; 2.11

(defun mul-interval-fast (x y)
  (defun posp (x) (>= x 0))
  (defun negp (x) (not (posp x)))
  (let ( (lx (lower-bound x))
	(ux (upper-bound x))
	(ly (lower-bound y))
	(uy (upper-bound y)))
    (cond
      ( (posp lx)
       (cond
	 ( (posp ly)                 (make-interval (* lx ly) (* ux uy)))
	 ( (and (negp ly) (posp uy)) (make-interval (* ux ly) (* ux uy)))
	 (t                         (make-interval (* ux ly) (* lx uy)))))
      ( (and (negp lx) (posp ux))
       (cond
	 ( (posp ly)                 (make-interval (* lx uy) (* ux uy)))
	 ( (and (negp ly) (posp uy)) (make-interval (min (* lx uy) (* ux ly))
						   (max (* lx ly) (* ux uy))))
	 (t                         (make-interval (* ux ly) (* lx ly)))))
      (t ;; first interval is completely negative
       (cond
	 ( (posp ly)                 (make-interval (* lx uy) (* ux ly)))
	 ( (and (negp ly) (posp uy)) (make-interval (* uy lx) (* ly lx)))
	 (t                         (make-interval (* ux uy) (* lx ly))))))))

(defun test-mult-interval-fast ()
  ;; I rushed through checking for errors with zeros.

    (defun assert-mults-correctly (lx ux ly uy le ue)
      (let ( (new-interval (mul-interval-fast (make-interval lx ux) (make-interval ly uy))))
	(assert (equal le (lower-bound new-interval)))
	(assert (equal ue (upper-bound new-interval)))))

    (assert-mults-correctly 0 0   0 0   0 0)

    (assert-mults-correctly 2 4    3  5     6 20)
    (assert-mults-correctly 2 4    0 0   0 0)
    (assert-mults-correctly 2 4   -3  5   -12 20)
    (assert-mults-correctly 2 4   -5 -3   -20 -6)

    (assert-mults-correctly -2 5    3  4    -8   20)
    (assert-mults-correctly -2 5    0 0   0 0)
    (assert-mults-correctly -2 5   -3  5    -15  25)
    (assert-mults-correctly -9 3   -9  10   -90  81)
    (assert-mults-correctly -2 5   -4  -3   -20   8)

    (assert-mults-correctly -4 -2    0 0        0 0)
    (assert-mults-correctly -4 -2    3  5    -20 -6)
    (assert-mults-correctly -4 -2   -3  5    -20 12)

    ;; this last one caught a bug.
    (assert-mults-correctly -4 -2   -5 -3     6  20))

;; 2.12

(defun make-center-percent (center percent)
  (make-interval (- center (* (/ percent 100) center)) (+ center (* (/ percent 100) center))))

(defun center-i (i)
  (/ (+ (lower-bound i) (upper-bound i)) 2))

(defun width-i (i)
  (/ (- (upper-bound i) (lower-bound i)) 2))

(defun percent (i)
  (if (equal (center-i i) 0)
      (error "division by 0")
      (* (/ (width-i i) (center-i i)) 100)))

;; 2.13

;; first interval is  [C1 - (p1*C1) , C1 + (p1 * C1)]
;; second interval is [C2 - (p2*C2) , C2 + (p2 * C2)]
;; Since they're both positive the new min is min x min and new max is max x max
;; We will show work for the min x min.
;; ( C1 - (p1 * C1) ) * ( C2 - (p2 * C2) )
;; C1C2 + p1c1p2c2 - p1c1c2 - p2c1x2
;; c1c2 + p1p2c1c2 - (p1 + p2)c1c2
;; c1c2 (p1p2 - (p1+p2)) c1c2.
;; Since p1 and p2 are small p1p2 is ~0 so this reduces to c1c2 - (p1+p2)c1c2
;; So the new percentage is p1 + p2.

;; 2.14
;; Everytime you multiply or divide something with error bounds, the error increases. So if you
;; make an interval by taking A / A, it is going to have more of an error than simply making
;; the interval 1.

(defun par1 (r1 r2)
  (div-interval-fixed (mul-interval r1 r2)
		      (add-interval r1 r2)))

(defun par2 (r1 r2)
  (let ( (one (make-interval 1 1)))
    (div-interval-fixed one
			(add-interval (div-interval-fixed one r1)
				      (div-interval-fixed one r2)))))

;; 2.15
;; par2 is indeed better because we are not unnecessarily compounding our error.

;; 2.16 I believe requires writing a library that has a large set of algebraic identities used for reducing algebraic expression. Possibly a TODO, but I probably will not do this exercise.

Chapter 1 SICP Answers in Common Lisp

April 8th, 2019

As I move towards a proper computer science education, I figure it'd be worthwhile to document my work. Perhaps someone in the future learning SICP will find an answer key written in CL helpful. The code provided is not polished nor checked very thoroughly. But I did see that most of my answers matched with the ones provided here. (link dead at time of writing)

NB: I realize I'm missing answers for 1.14 and 1.15 . They should be uploaded shortly.


;; answers for 1.1
;; 10
;; 12
;; 8
;; 3
;; -16
;; switched define->defparameter
;; A
;; B
;; nil
;; 4
;; 16
;; 6
;; 16
=
;; 1.2
(defparameter *ans2* (/ (+ 5 4 (- 2 (- 3 (+ 6 (/ 4 5))))) (* 3 (- 6 2) (- 2 7))))

;; 1.3

(defun ans3 (a b c)
(defun square (x) (* x x))
(defun sum-of-squares (a b) (+ (square a) (square b)))
(cond
((and (<= c a) (<= c b)) (sum-of-squares a b))
((and (<= b c) (<= b a)) (sum-of-squares a c))
('t                      (sum-of-squares b c))))

;; 1.4

;; describe the following function
;; ( (if (> b 0) + -) a b) )
;; Adds a plus the absolute value of b. in CL would need explicit funcall.

;; 1.5
;; infinite loop if applicative order, 0 if normal order

(defun p () (p))

(defun test (x y) (if (equal x 0) 0 y))

;; 1.6
;; The function gets caught in an infinite loop, because all the parameters are evaluated
;; first so it doesn't have a base case.

(defun square (x) (* x x))
(defun good-enough? (guess x) (< (abs (- (square guess) x)) .0001))
(defun average (a b) (/ (+ a b) 2))
(defun improve (guess x) (average guess (/ x guess)))
(defun sqrt-itr (guess x)
(if (good-enough? guess x)
guess
(sqrt-itr (improve guess x) x)))

;; 1.7
(defun new-sqrt-itr (guess x)
(if (< ( / (abs (- (improve guess x) guess)) guess) (* guess .0001))
guess
(new-sqrt-itr (improve guess x) x)))

;; 1.8
(defun cube (x) (* x x x))
(defun cube-good-enough?
(guess x)
(<= (abs (- (cube-improve guess x) guess)) (abs (* .0001 guess))))

(defun cube-improve (guess x) (/ (+ (/ x (square guess)) (* 2 guess)) 3))
(defun cube-root-itr (guess x)
(print (float guess))
(if (cube-good-enough? guess x)
guess
(cube-root-itr (cube-improve guess x) x)))

;; 1.9
;; First one is recursive process
;; Second one is iterative process

;; 1.10
;; (A 1 10) = 2^10
;; (A 2 4) = 2^16
;; (A 3 3) = (A 2 4) = 2^16

;; (f n) = 2n
;; (g n) = 2^n
;; (h n) = 2 ^ h(n-1) h(0) = 0

;; 1.11
(defun f-recursive (n)
(if (< n 3)
n
(+ (f-recursive (- n 1)) (* 2 (f-recursive (- n 2))) (* 3 (f-recursive (- n 3))))))

(defun f-iterative (n)
(defun f-iterative-helper (f1 f2 f3 count final)
(if (equal count final)
f3
(f-iterative-helper f2 f3 (+ (* f1 3) (* f2 2) f3) (+ count 1) final)))
(if (< n 3) n
(f-iterative-helper 0 1 2 2 n)))

;; 1.12
(defun pascals-triangle (n)
(defun get-harmonic-addition (n) (/ (- (sqrt (+ 1 (* 8 n))) 1) 2))
(defun is-on-edge? (n)
(defun is-mod-addition-whole-integer (x)
(equal (mod (get-harmonic-addition x) 1) 0.0))
(or (is-mod-addition-whole-integer n) (is-mod-addition-whole-integer (+ n 1))))
(defun get-current-level (n) (floor (get-harmonic-addition n)))
(if (is-on-edge? n)
1
(+ (pascals-triangle (- n (get-current-level n) 1))
(pascals-triangle (- n (get-current-level n))))))







fibproof1







fibproof2







1.14 -> 1.15 coming soon


;; 1.16
(defun iterative-repeated-squaring (b n)
"page 46"
(defun square   (x) (* x x))
(defun is-evenp (x) (equal (mod x 2) 0))
(defun iter-expt (b n a)
(cond
((equal n 0)  a)
((is-evenp n) (iter-expt (square b) (- (/ n 2) 1) (* a (square b))))
('t           (iter-expt b (- n 1) (* a b)))))
(iter-expt b n 1))
(defun is-evenp (x) (equal (mod x 2) 0))

;; 1.17
(defun my-multiply (a b)
(defun my-double (x) (* x 2))
(defun half   (x) (/ x 2))
(cond
((equal b 0)  0)
((is-evenp b) (my-multiply (my-double a) (half b)))
(t            (+ a (my-multiply a (- b 1))))))

;; 1.18
(defun my-mult-iterative (a b)
(defun my-double (x) (* x 2))
(defun half   (x) (/ x 2))
(defun my-mult-itr (a b c)
(cond
((equal b 0)  c)
((is-evenp b) (my-mult-itr (my-double a) (half b) c))
(t            (my-mult-itr a (- b 1)  (+ c a)))))
(my-mult-itr a b 0))

;; 1.19
(defun fib (n) (fast-fib 1 0 0 1 n))
(defun fast-fib (a b p q count)
(defun square (x) (* x x))
(cond ( (equal count 0) b)
((is-evenp count)
(fast-fib a b (+ (square p) (square q)) (+ (* 2 p q) (square q)) (/ count 2)))
(t (fast-fib (+ (* b q) (* a q) (* a p))
(+ (* b p) (* a q))
p
q
(- count 1)))))

;; 1.20 18 / 4 (the big thing here is that the if statement is where the actual reduction of the gcd happens)

;; 1.21 199, 1999, 7
(defun smallest-divisor (n)
(defun dividesp (a b) (equal (mod b a) 0))
(defun find-divisor (n test-divisor)
(cond ( (> (square test-divisor) n) n)
((dividesp test-divisor n) test-divisor)
(t (find-divisor n (+ test-divisor 1)))))
(find-divisor n 2))

(defun primep (n)
(equal (smallest-divisor n) n))

(defun timed-prime-test (n)
(defun prime-test (n start-time)
(if (primep n)
(progn
(princ n)
(princ "*****")
(princ (- (get-internal-run-time) start-time))
(print "")
)))
(prime-test n (get-internal-run-time)))

;; 1.22
;; 1013, 1019, 1021 (0 seconds all)
;; 10009, 10037, 10039 (0 seconds all)
;; 100019, 100043, 100049, (0 seconds)
;; 1000033, 1000037, 1000039, (0 seconds)
(defun search-for-primes (n limit)
(if (< n limit)
(progn (timed-prime-test n) (search-for-primes (+ n 2) limit))))

;; 1.25 problem is that the number gets super big, should be taking mod m along the way.
;; 1.26  logn height but number of leaves are doubling every round since u call expmod recursively twice.

(defun expmod (base exp m)
(cond ( (equal exp 0) 1)
((evenp exp) 	 (mod (square (expmod base (/ exp 2) m)) m))
(t               (mod (* base (expmod base (- exp 1) m)) m))))

(defun expmod-miller (base exp m)
;; i had a bug where i wasn't checking > exp 0...caused issues for a bit with infinite loop
(let ( (mod-of-half-exp (if (and (> exp 0) (evenp exp)) (expmod-miller base (/ exp 2) m))))
(cond ( (equal exp 0) 1)
((and (evenp exp)
(not (or (equal mod-of-half-exp 1) (equal mod-of-half-exp (- m 1))))
(equal (mod (square mod-of-half-exp) m) 1)) 0)
((evenp exp) 	 (mod (square mod-of-half-exp) m))
(t               (mod (* base (expmod-miller base (- exp 1) m)) m)))))

(defun fermat-full-test (n)
(defun fermat-test (a n)
(if (>= a n) t (and (equal (expmod a n n) a) (fermat-test (+ a 1) n))))
(fermat-test 2 n))

(defun miller-rabin-full-test (n)
(defun miller-rabin-test (a n)
(if (>= a n) t (and (equal (expmod-miller a n n) a) (miller-rabin-test (+ a 1) n))))
(miller-rabin-test 2 n))

;; 1.29
(defun simpson-integrate (f a b n)
(defun get-h () (/  (- b a) n))
(defun simpson-integrate-itr (h k current-sum)
(defun current-step-value ()  (funcall f (+ a (* h k))))
(cond
((equal k n) (+ current-sum (current-step-value)))
((equal k 0) (simpson-integrate-itr h (+ k 1) (current-step-value)))
((evenp k)   (simpson-integrate-itr h (+ k 1) (+ current-sum (* 2 (current-step-value)))))
(t           (simpson-integrate-itr h (+ k 1) (+ current-sum (* 4 (current-step-value)))))))
(* (/ (get-h) 3) (simpson-integrate-itr (get-h) 0 0)))

;; 1.30
(defun my-sum (term a next b)
(defun iter (a result)
(if (> a b)
result
(iter (funcall next a) (+ result (funcall term a)))))
(iter a 0))

;; 1.31 recursive process

(defun pi-over-4-term (a)
(/  (+ (* (floor a       2) 2) 2)
(+ (* (floor (+ a 1) 2) 2) 1)))

(defun pi-over-4-next (a) (+ a 1))
;; a

(defun my-product (term a next b)
(if (> a b)
1
(* (funcall term a) (my-product term (funcall next a) next b))))

;; b

(defun my-product-itr (term a next b)
(defun iter (a result)
(if (> a b)
result
(iter (funcall next a) (* result (funcall term a)))))
(iter a 1))

;; 1.32 accumulate

;; a
;; (accumulate-recursive #'+ 0 (lambda (x) x) 0 (lambda (x) (+ x 1)) 10)
;; (accumulate-recursive #'* 1 (lambda (x) x) 1 (lambda (x) (+ x 1)) 4)
(defun accumulate-recursive (combiner null-value term a next b)
(if (> a b)
null-value
(funcall combiner (funcall term a)
(accumulate-recursive combiner null-value term (funcall next a) next b))))

;; b
;; (accumulate-iterative #'* 1 (lambda (x) x) 1 (lambda (x) (+ x 1)) 4)
;; (accumulate-iterative #'+ 0 (lambda (x) x) 0 (lambda (x) (+ x 1)) 10)
(defun accumulate-iterative (combiner null-value term a next b)
(defun iter (a result)
(if (> a b)
result
(iter (funcall next a) (funcall combiner result (funcall term a)))))
(iter a null-value))

;; 1.33
;; (filter-accumulate #'primep #'+ 0 #'square 2 (lambda (x) (+ x 1)) 5)

;; kept to show error i made. notice how i accidently call accumulate-recursive
;; because i was copying and pasting the previous code without fully changing it.
;; i also didn't notice the bug because it was hard to tell for low values, since it filters
;; the first value correctly.
(defun filter-accumulate-broken (filter combiner null-value term a next b)
(if (> a b)
null-value
(cond
((funcall filter a)
(funcall combiner (funcall term a)
(accumulate-recursive combiner null-value term (funcall next a) next b)))
(t (funcall combiner
null-value
(accumulate-recursive combiner null-value term (funcall next a) next b))))))

(defun filter-accumulate (filter combiner null-value term a next b)
(if (> a b)
null-value
(funcall combiner (if (funcall filter a) (funcall term a) null-value)
(filter-accumulate filter combiner null-value term (funcall next a) next b))))

(defun sum-of-squares-of-primes (n)
(filter-accumulate #'primep #'+ 0 #'square 2 (lambda (x) (+ x 1)) n))

(defun product-of-relative-primes-less-than-n (n)
(filter-accumulate
(lambda (x) (equal (gcd n x) 1)) #'* 1 (lambda (x) x) 2 (lambda (x) (+ x 1)) (- n 1)))

;; 1.34
;; (f f) -> (f 2) -> (2 2)

;; 1.35
;; x -> 1 + 1 / x
;; x^2 = 1 + x

(defun average-damp (f) (lambda (x) (average x (funcall f x))))

;; This originally had (average-damp f) in the if statement, but it was removed after doing the q.
(defun fixed-point (f &optional (first-guess 1))
(defun iter (old new)
(if (< (abs (- new old)) .0001)
new
(iter new (funcall f new))))
(iter first-guess (funcall f first-guess)))

;; 1.36
;; = 30 iterations with tolerance .0001 and no average damping.
;; =  9 iterations with tolerance .0001 and average damping.
(defun fixed-point-expanded (f &optional (first-guess 1))
(defun iter (old new)
(print new)
(if (< (abs (- new old)) .0001)
new
(iter new (funcall (average-damp f) new))))
(iter first-guess (funcall f first-guess)))

;; 1.37
;; a)
;; it takes k=11  to get it right to 4 decimal places.
;; recursive version
(defun infinite-continued-fraction (n d k)
(defun iter (i)
(/ (funcall n i) (+ (funcall d i) (if (equal i k) 0 (iter (+ i 1))))))
(iter 1))

;; b)
;; iterative version
(defun infinite-continued-fraction-iterative (n d k)
;; work backwards for iterative process
(defun iter (i current-denominator)
(cond
((equal i 1) (/ (funcall n i) current-denominator))
(t           (iter (- i 1) (+ (funcall d (- i 1)) (/ (funcall n i) current-denominator))))))
(iter k (funcall d k)))

;; euler expansion e - 2
;; 1.38 infinite continued fraction with ni = 1 and di = 1,2,1,1,4,6,1,1,8
(defun euler-e-expanion (&optional (steps 10))
(defun ni (i) 1.0)
(defun di (i)
(if (equal (mod i 3) 2)
(* (+ (floor i 3) 1) 2)
1.0))
(infinite-continued-fraction #'ni #'di steps))

;; 1.39 Lambert tanx

(defun tan-cf (x k)
(defun ni (i) (if (equal i 1) x (- (square x))))
(defun di (i) (+ (* 2 (- i 1)) 1))
(infinite-continued-fraction #'ni #'di k))

;; 1.40

(defun deriv (f &optional (dx .0001))
(lambda (x) (/ (- (funcall f (+ x dx)) (funcall f x)) dx)))

(defun newton-transform (f)
(lambda (x) ( - x (/ (funcall f x) (funcall (deriv f) x)))))

(defun newtons-method (g guess)
(fixed-point (newton-transform g) guess))

(defun cubic (a b c)
(lambda (x) (+ (expt x 3) (* a (expt x 2)) (* b x) c)))

;; 1.41
(defun inc (x) (+ x 1))

(defun double-compose (f)
(lambda (x) (funcall f (funcall f x))))
; (funcall (funcall (double-compose (double-compose #'double-compose)) #'inc) 5) = 21

;; 1.42

(defun compose (f g)
(lambda (x) (funcall f (funcall g x))))

;; 1.43

(defun repeated-composition (f n)
(if (equal n 1)
f
(compose f (repeated-composition f (- n 1)))))

;; 1.44

(defun smooth (f)
(lambda (x)
(let ( (dx .0001))
(/ (+ (funcall f (- x dx))
(funcall f x)
(funcall f (+ x dx)))
3))))

(defun n-fold-smooth (f n)
(funcall (repeated-composition #'smooth n) f))

;; 1.45

(defun fixed-point-of-transform (g transform guess)
(fixed-point (funcall transform g) guess))

;;

;; I had issues with this because it was running out of memory for a different reason-namely from
;; display huge fractions. It only works consistently if you make sure that n is a float!
(defun nth-root (x n)
(fixed-point-of-transform
(lambda (y) (/ x (iterative-repeated-squaring y (- n 1))))
(repeated-composition #'average-damp (floor (log n 2)))
1))

;; 1.46

(defun iterative-improve (improve-guess good-enoughp)
(defun iter (guess)
(if (funcall good-enoughp guess)
guess
(iter (funcall improve-guess guess))))
#'iter)

(defun sqrt-iter-improve (n)
(funcall (iterative-improve
(average-damp (lambda (guess) (/ n guess)))
(lambda (guess) (< (abs (- (square guess) n)) .0001))) 1))

(defun fixed-point-iter-improve (f)
(funcall (iterative-improve
(lambda (guess) (funcall f guess))
(lambda (guess) (< (abs (- (funcall f guess) guess)) .0001))) 1))