;;;;;;
;;;
;;; Solution to Exercise 1
;;;
;;; by Hongwei Xi
;;;
;;;;;;

;;; the following strategy wins about 1.5% (over a million hands),
;;; though the strategy is unstable because of the significant bet
;;; spreading.

(load "new-dealer.scm")

(define (between d lo hi)
  (and (<= lo d) (<= d hi)))

;;; basic strategy for more than 2 cards
(define (basic-strategy-sum d sum)
  (cond ((between sum 4 11) 'hit)
	((= sum 12)
	 (if (between d 4 6) 'stand 'hit))
	((between sum 13 16)
	 (if (between d 2 6) 'stand 'hit))
	((<= 17 sum) 'stand)
	(else (error "basic-strategy-sum: " sum))))

;;; basic strategy for some special cases of 2 cards
(define (basic-strategy-init d c1 c2 sum) ;; assume c1 <= c2
  (cond ((= c1 1)
	 (cond ((= c2 1) 'split)
	       ((between c2 2 3)
		(if (between d 5 6) 'double 'hit))
	       ((between c2 4 5)
		(if (between d 4 6) 'double 'hit))
	       ((= c2 6)
		(if (between d 3 6) 'double 'hit))
	       ((= c2 7)
		(if (between d 3 6)
		    'double
		    (if (or (= d 2) (between d 7 8)) 'stand 'hit)))
	       (else 'stand)))
	((= c1 c2)
	 (cond ((between c1 2 3) (if (between d 2 7) 'split 'hit))
	       ((= c1 4) (if (between d 5 6) 'split 'hit))
	       ((= c1 5) (if (between d 2 9) 'double 'hit))
	       ((= c1 6) (if (between d 2 6) 'split 'hit))
	       ((= c1 7) (if (between d 2 7) 'split 'hit))
	       ((= c1 8) 'split)
	       ((= c1 9)
		(if (or (between d 2 6) (between d 8 9)) 'split 'stand))
	       ((= 10 c1) 'stand)
	       (else (error "basic-strategy-init: " c1 c2))))
	(else (basic-strategy-sum-init d sum))))

;;; basic strategy for the rest cases of 2 cards
(define (basic-strategy-sum-init d sum)
  (cond ((between sum 5 8) 'hit)
	((= sum 9)
	 (if (between d 3 6) 'double 'hit))
	((= sum 10)
	 (if (between d 2 9) 'double 'hit))
	((= sum 11)
	 (if (between d 2 10) 'double 'hit))
	((= sum 12)
	 (if (between d 4 6) 'stand 'hit))
	((between sum 13 14)
	 (if (between d 2 6) 'stand 'hit))
	((= sum 15)
	 (cond ((between d 2 6) 'stand)
	       ((or (= d 1) (between d 7 9)) 'hit)
	       ((= d 10) 'surrender)))
	((= sum 16)
	 (cond ((between d 2 6) 'stand)
	       ((or (= d 1) (between d 7 8)) 'hit)
	       ((<= 9 d) 'surrender)))
	((<= 17 sum) 'stand)
	(else (error "basic-strategy-sum-init: " sum))))

;;; please notice how a closure is built
(define player-strategy
  (let ((number-of-used-cards 0)
	(card-count 0)
	(insurance-count -4) ; six decks of cards
	(insured #f)
	(count-unit (/ 1 100)))

;;; this function does high-low counting; it also checks whether
;;; it is favorable to take insurance
    (define (count-cards used-cards)
      (let ((card (vector-ref used-cards number-of-used-cards)))
	(let ((val (val-of-card card)))
	  (if (= val 0)
	      (/ card-count
		 (- (vector-length used-cards) number-of-used-cards))
	      (begin
		(set! number-of-used-cards (1+ number-of-used-cards))
		(if (< val 10)
		    (set! insurance-count (+ insurance-count 1))
		    (set! insurance-count (- insurance-count 2)))
		(cond ((between val 2 6)
		       (begin (set! card-count (1+ card-count))
			      (count-cards used-cards)))
		      ((between val 7 9)
		       (count-cards used-cards))
		      (else; (or (= val 1) (= val 10))
		       (begin (set! card-count (- card-count 1))
			      (count-cards used-cards)))))))))

;;; this is the strategy for deciding the initial bet
    (define (player-initial used-cards player-account)
      (set! insured #f)
      (if (= 0 (vector-ref used-cards number-of-used-cards))
	  (begin (set! number-of-used-cards 0)
		 (set! insurance-count -4)
		 (set! card-count 0)))		 
      (let ((average (count-cards used-cards)))
	(if (< average (* 8 count-unit)) 10 500)))

;;; this is the strategy for playing
    (define (player bet-hand dealer-up-card used-cards player-account)
      (let ((sum (greatest-value bet-hand))
	    (d (val-of-card dealer-up-card)))
	(if (= 2 (bet-hand 'number-of-cards))
	    (let ((cards (cards-of-hand bet-hand)))
	      (let ((c1 (val-of-card (car cards)))
		    (c2 (val-of-card (cadr cards))))
		(if (and (not insured)
			 (= d 1)
			 (< 1 (+ insurance-count
				 (if (< c1 10) 1 -2)
				 (if (< c2 10) 1 -2))))
		    (begin (set! insured #t) 'insure)
		    (if (<= c1 c2)
			(basic-strategy-init d c1 c2 sum)
			(basic-strategy-init d c2 c1 sum)))))
	    (basic-strategy-sum d sum))))

    (cons player-initial player)))

(define player-initial (car player-strategy))
(define player (cdr player-strategy))

;;;;;;
;;;
;;; Solution to Exercise 3
;;;
;;; by Hongwei Xi
;;;
;;;;;;

(define (make-table)
  (define table ())
  (define (get key table)
    (if (null? table)
        (error "key is not found in the method table: " key)
        (if (equal? key (caar table)) (cdar table) (get key (cdr table)))))

  (define (put! pair) (set! table (cons pair table)))

  (define (dispatch msg)
    (cond ((eq? (car msg) 'get) (get (cadr msg) table))
          ((eq? (car msg) 'put) (put! (cadr msg)))
          (else "MAKE-TABLE: unknown message: " msg)))
  dispatch)

(define number-object-class
  (let ((method-table (make-table)))
    (define (get key) (method-table (list 'get key)))
    (define (put! pair) (method-table (list 'put pair)))

    (define (new n)
      (define (dispatch msg)
	(cond ((eq? (car msg) 'value) n)
	      (else (let ((code (get (car msg))))
		      (code (cons dispatch (cdr msg)))))))
      dispatch)

    (define (dispatch msg)
      (cond ((eq? (car msg) 'new) (new (cadr msg)))
	    ((eq? (car msg) 'add-method)
	     (put! (cons (second msg) (third msg))))
	    (else (error "NUMBER_OBJECTS: unknown message: " msg))))
    dispatch))

(define (make-number-object n) (number-object-class (list 'new n)))
(define (value-of nobj) (nobj (list 'value)))

(define (add-method name method)
  (number-object-class (list 'add-method name method)))

(define *none*
  (begin
    (add-method 'add
		(lambda (args)
		  (make-number-object
		   (+ (value-of (car args)) (value-of (cadr args))))))
    (add-method 'sub
		(lambda (args)
		  (make-number-object
		   (- (value-of (car args)) (value-of (cadr args))))))
    (add-method 'mul
		(lambda (args)
		  (make-number-object
		   (* (value-of (car args)) (value-of (cadr args))))))
    (add-method 'div
		(lambda (args)
		  (make-number-object
		   (/ (value-of (car args)) (value-of (cadr args))))))
    (add-method 'factorial
		(let ((f (lambda (n) (if (= n 0) 1 (* n (f (- n 1)))))))
		  (lambda (args) (make-number-object (f (value-of (car args)))))))
    (add-method 'print
		(lambda (args) (display (value-of (car args)))))))


;;;;;;
;;;
;;;
;;; Exercise 2
;;; by Nenad
;;;
;;;;;;
; BU CAS CS320, Spring 2002

; Solution of the problem 1 on the problem set 6
; Provided by Nenad Dedic

; This one is easy. It just reverses the list. Use the environment model to
; see that.

(define (mystery x)
  (define (loop x y)
    (if (null? x)
	y
	(let ((temp (cdr x)))
	  (set-cdr! x y)
	  (loop temp x))))
  (loop x '()))

; BU CAS CS320, Spring 2002

;;;;;;
;;;
;;;
;;; Exercise 4
;;; by Nenad
;;;
;;;;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; We'll need the original one-dimensional table implementation

(define (lookup key table)
  (let ((record (assoc key (cdr table))))
    (if record
        (cdr record)
        false)))

(define (assoc key records)
  (cond ((null? records) false)
        ((equal? key (caar records)) (car records))
        (else (assoc key (cdr records)))))

(define (insert! key value table)
  (let ((record (assoc key (cdr table))))
    (if record
        (set-cdr! record value)
        (set-cdr! table
                  (cons (cons key value) (cdr table)))))
  'ok)

(define (make-table)
  (list '*table*))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; MAIN CODE STARTS HERE

(define (make-n-table)
  (list '*n-table*))

; just an auxiliary procedure

(define (cr-ins! key value table)
  (if (null? key)
      (insert! key value table)
      (insert! (car key) (cr-ins! (cdr key) value (make-n-table)) table))
  table)

(define (insert-n! key value table)
  (if (null? key)
      (insert! key value table)
      (let ((record (lookup (car key) table)))
	(if (null? record)
	    (cr-ins! key value table)
	    (begin
	      (insert-n! (cdr key) value record)
	      (insert! (car key) record table))))))

(define (lookup-n key table)
  (if (null? key)
      (lookup key table)
      (let ((record (lookup (car key) table)))
	(if (null? record)
	    '()
	    (lookup-n (cdr key) record)))))

;;;;;;
;;;
;;;
;;; Exercise 5
;;; by Nenad
;;;
;;;;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Old stuff first:

(define (front-ptr queue) (car queue))

(define (rear-ptr queue) (cdr queue))

(define (set-front-ptr! queue item) (set-car! queue item))

(define (set-rear-ptr! queue item) (set-cdr! queue item))

(define (empty-queue? queue) (null? (front-ptr queue)))

(define (make-queue) (cons '() '()))

(define (front-queue queue)
  (if (empty-queue? queue)
      (error "FRONT called with an empty queue" queue)
      (car (front-ptr queue))))

(define (insert-queue! queue item)
  (let ((new-pair (cons item '())))
    (cond ((empty-queue? queue)
           (set-front-ptr! queue new-pair)
           (set-rear-ptr! queue new-pair)
           queue)
          (else
           (set-cdr! (rear-ptr queue) new-pair)
           (set-rear-ptr! queue new-pair)
           queue))))

(define (delete-queue! queue)
  (cond ((empty-queue? queue)
         (error "DELETE! called with an empty queue" queue))
        (else
         (set-front-ptr! queue (cdr (front-ptr queue)))
         queue)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; THE SOLUTION:

(define q1 (make-queue))

(insert-queue! q1 'a)

(insert-queue! q1 'b)

(delete-queue! q1)

(delete-queue! q1)

; the results are unexpected, because the rear-pointer is also printed out
; as a part of the queue; rear-pointer does not have an obvious interpretation,
; though, so it is confusing as a part of output

(define (print-queue q)
  (if (empty-queue? q)
      (display 'empty)
      (display (front-ptr q))))