; BU CAS CS320, S2002
; Solution set 4
; provided by Nenad Dedic

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; Solution 1

;;; O(log n)-time and O(1)-space implementation of exponentiation
(define (expt x n)
  (define (aux x n res)
;   (format #t "expt: aux: n = ~A\n" n)
    (cond ((= n 0) res)
	  ((= n 1) (* x res))
	  (else (let ((qr (integer-divide n 2)))
		    (if (eq? (cdr qr) 0)
			(aux (* x x) (car qr) res)
			(aux (* x x) (car qr) (* x res)))))))
  (aux x n 1))

(define (ncons h t)
  (* (expt 2 h) (expt 3 t)))

(define (ncar l)
  (define (aux l n)
    (if (= (modulo l 2) 0)
	(aux (/ l 2) (+ n 1))
	n))
  (aux l 0))

(define (ncdr l)
  (define (aux l n)
    (if (= (modulo l 3) 0)
	(aux (/ l 3) (+ n 1))
	n))
  (aux l 0))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; Solution 2

(define (inlist e l)
  (cond ((null? l) #f)
	((equal? e (car l)) #t)
	(else (inlist e (cdr l)))))

(define (shuffle)
  (define (aux deck n)
;    (display deck)
;    (newline)
    (let ((card (list (+ 1 (random 4)) (+ 1 (random 13)))))
      (cond ((= n 52) deck)
	    ((inlist card deck) (aux deck n))
	    (else (aux (cons card deck) (+ n 1))))))
  (aux '() 0))

;;;;;;
;;;
;;; Another Implementation: much faster!
;;;
;;; Hongwei Xi
;;;
;;;;;;
(define nil ())

(define (shuffle)
  ;;; the number of cards
  (define number-of-cards (* 4 13))

  ;;; allocate a vector to store cards
  (define deck (make-vector number-of-cards 0))
  
  ;;; swap two cells in a vector
  (define (swap i j)
    (if (eq? i j) nil
	(let ((c (vector-ref deck i)))
	  (vector-set! deck i (vector-ref deck j))
	  (vector-set! deck j c))))

  ;;; turn a number into a card suite and value
  (define (card-of-number v)
     (let ((qr (integer-divide v 13)))
       (cons (1+ (car qr)) (1+ (cdr qr)))))

  ;;; initialize the deck
  (define (initialize)
    (define (aux i)
      (if (< i number-of-cards)
	  (begin (vector-set! deck i (card-of-number i)) (aux (1+ i)))))
    (aux 0))

  ;;; randomize the dec: do you understand the trick here?
  ;;; no check for identical cards!
  (define (randomize)
    (define (aux i)
      (if (> i 0)
          (begin (swap (- i 1) (random i)) (aux (- i 1)))))
    (aux number-of-cards))

  ;;; turn a vector into a list
  (define (list-of-vector vec)
    (define (aux i res)
      (if (<= 0 i)
	  (aux (- i 1) (cons (vector-ref vec i) res)) res))
    (aux (- number-of-cards 1) nil))

  ;;; that is it!
  (initialize)
  (randomize)
  (list-of-vector deck))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; Solution 3

(define (cpsmap f xs k)
  (cond ((null? xs) (k '()))
	(else (cpsmap f (cdr xs) (lambda (r) (k (cons (f (car xs)) r)))))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; Solution 4

(define (deep-reverse l)
  (define (aux x)
    (cond ((list? x) (reverse (map aux x)))
	  (else x)))
  (aux l))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; Solution 6

(define (goodmatrix m)
  (define (auxand x y)
    (and x y))
  (if (null? m)
      #f
      (if (null? (cdr m))
	  #f
	  (let ((rows (car m)) (cols (cadr m)) (a (cddr m)))
	    (if (not (= (length a) rows))
		#f
		(if (not (fold-left auxand #t
				    (map (lambda (x) (= (length x) cols)) a)))
		    #f
		    #t))))))

(define (transpose m)
  (define (aux m)
    (if (null? m)
	(list (list))
	(if (null? (car m))
	    (list)
	    (cons (map car m)
		  (aux (map cdr m))))))
  (cons (cadr m) (cons (car m) (aux (cddr m)))))

(define (mmul p q)
  (define (dotp a b)
    (if (null? a)
	0
	(+ (* (car a) (car b)) (dotp (cdr a) (cdr b)))))
  (define (mmulaux u v)
    (define (aux a b row mtx)
      (if (not (null? a))
	  (if (not (null? b))
	      (aux a (cdr b) (append row (list (dotp (car a) (car b)))) mtx)
	      (aux (cdr a) v '() (append mtx (list row))))
	  mtx))
    (aux u v '() '()))
  (cons (car p) (cons (cadr q) (mmulaux (cddr p) (cddr (transpose q)) ))))