#lang scheme
; Haskell's prelude drop and take functions
(define (drop n xs)
  (cond [(null? xs) xs]
        [(<= n 0)   xs]
        [else       (drop (sub1 n) (rest xs))]))

(define (take n xs)
  (cond [(null? xs) null]
        [(<= n 0)   null]
        [else       (cons (first xs) (take (sub1 n) (rest xs)))]))

(define (my-length xs)
  (if (null? xs) 
      0
      (+ 1 (my-length (rest xs)))))

(define (mean xs)
  (/ (apply + xs)
     (length xs)))

(define (make-palindrome xs)
  (append xs (reverse xs)))

(define (make-palindrome-2 xs)
  (if (null? xs) 
      xs
      (append xs (rest (reverse xs)))))

(define (palindrome? xs)
  (equal? xs (reverse xs)))

(define (length-sort lls)
  (sort lls 
        (lambda (x y)
          (<= (length x) (length y)))))

(define (intersperse sep xs)
  (cond [(null? xs) null]
        [(null? (rest xs)) xs]
        [else (append (list (first xs) sep)
                      (intersperse sep (rest xs)))]))

(define-struct tree (node left right))
(define empty-tree (make-tree 'empty 'empty 'empty))
(define (empty-tree? t)
  (and (eq? 'empty (tree-node t))
       (eq? 'empty (tree-left t))
       (eq? 'empty (tree-right t))))

(define (tree-height t)
  (if (empty-tree? t)
      0
      (add1 (max (tree-height (tree-left t))
                 (tree-height (tree-right t))))))

(define-struct point (x y))
(define (print-point p) (printf "(~a ~a)" (point-x p) (point-y p)))
(define (print-points ps) (for-each print-point ps))

; compare two points
(define (point<=? p1 p2)
  (cond [(< (point-y p1) (point-y p2)) true]
        [(> (point-y p1) (point-y p2)) false]
        [else (<= (point-x p1) (point-x p2))]))

(define (direction p1 p2 p3)
  (let* ([p1x (point-x p1)] 
         [p1y (point-y p1)]
         [p2x (point-x p2)] 
         [p2y (point-y p2)]
         [p3x (point-x p3)] 
         [p3y (point-y p3)]
         [cross (- (* (- p2x p1x)
                      (- p3y p1y))
                   (* (- p2y p1y)
                      (- p3x p1x)))])
    (cond [(< cross 0) 'right]
          [(> cross 0) 'left]
          [else        'straight])))

; 3 or more points are needed to calculate a convex hull
(define (too-short? ps)
  (or (null? ps)
      (null? (rest ps))
      (null? (rest (rest ps)))))

(define (directions ps)
  (if (too-short? ps) 
      null
      (cons (direction (first ps)
                       (first (rest ps))
                       (first (rest (rest ps))))
            (directions (rest ps)))))

(define (graham-scan ps)

  (define (contiguous-left-turns hull ps)
    (if (null? ps)
        (reverse hull)
        (let* ([h1 (first hull)]   
               [h2 (second hull)]  ; NB hull always has at least 2 points due to the cotan sort
               [hs (rest (rest hull))]
               [p  (first ps)]
               [right-turn? (eq? 'right (direction h2 h1 p))])
          (if right-turn?
              (contiguous-left-turns (cons h2 hs)  ps)
              (contiguous-left-turns (cons p hull) (rest ps))))))
  
  (if (too-short? ps) 
      null
      (let* ([sorted-points    (cotan-sort ps)] 
             [initial-hull     (reverse (take 3 sorted-points))]
             [remaining-points (drop 3 sorted-points)])
        (contiguous-left-turns initial-hull remaining-points))))

(define (cotan-sort ps) 
  (define (cotan<? pivot)
    (lambda (p q)
      (let* ([pivot-x (point-x pivot)]
             [pivot-y (point-y pivot)]
             [px (point-x p)] [py (point-y p)]
             [qx (point-x q)] [qy (point-y q)]
             [cotan-p (* (- py pivot-y) (- qx pivot-x))]
             [cotan-q (* (- qy pivot-y) (- px pivot-x))])
        (cond [(< cotan-p cotan-q) true]
              [(> cotan-p cotan-q) false]
              [(> py qy)           true]
              [(< py qy)           false]
              [(< px qx)           true]
              [else                false]))))
  
  (let* ([initial-sort (sort ps point<=?)]
         [pivot (first initial-sort)])
    (cons pivot (sort (rest initial-sort) (cotan<? pivot)))))


(define test-points (list 
                     (make-point  0  0) (make-point  3 -10)
                     (make-point -3 -4) (make-point -7 -1) 
                     (make-point -7  1) (make-point -3  4)
                     (make-point  3  7) (make-point  5  0)))

(define test-grid (list
                   (make-point 0 0) (make-point 2 0) (make-point 4 0) (make-point 6 0)
                   (make-point 1 1) (make-point 3 1) (make-point 5 1)
                   (make-point 0 2) (make-point 2 2) (make-point 4 2) (make-point 6 2)
                   (make-point 1 3) (make-point 3 3) (make-point 5 3)
                   (make-point 0 4) (make-point 2 4) (make-point 4 4) (make-point 6 4)
                   (make-point 1 5) (make-point 3 5) (make-point 5 5)
                   (make-point 0 6) (make-point 2 6) (make-point 4 6) (make-point 6 6)))