;;;
;;; auction.ss
;;; UVA CS200 Spring 2003
;;; Final
;;;

;;; Version 1.0.1 - new for Spring 2003

(load "database.ss")

;;; Table of people who can bid on items
(define bidders (make-new-table (list 'name 'email)))

;;; Table of the items currently up for auction
(define items (make-new-table (list 'item-name 'description)))

;;; Table of all bids on
(define bids (make-new-table (list 'bidder-name 'item-name 'amount)))

(define (get-bids item)
  (table-entries (table-select bids 'item-name (make-string-selector item))))

(define (get-bid-values item)
  (map bid-bid (table-entries (table-select bids 'item-name (make-string-selector item)))))

(define (add-bidder name email)
  (table-insert! bidders (list name email)))

(define (post-item name description)
  (table-insert! items (list name description)))

(define (insert-bid bidder item amount)
  (table-insert! bids (list bidder item amount)))

(define (cancel-bids bidder)
  (table-delete! bids 'bidder-name (make-string-selector bidder)))

(define (bid-amount bid)
  (let ((bidval (get-nth bid (find-field-number bids 'amount))))
    (if (bidbot? bidval)
	(if (bidbot-amount bidval)
	    (bidbot-amount bidval)
	    0) ; need to evaluate to 0 instead of #f
	bidval)))

;;; Gets the bid part of a bid entry
(define (bid-bid bid)
  (get-nth bid (find-field-number bids 'amount)))

;;; Gets the bidder part of a bid entry
(define (bid-bidder bid)
  (get-nth bid (find-field-number bids 'bidder-name)))

(define (get-highest-bid item)
  (let ((sortbids 
	 (quicksort
	  (lambda (entry1 entry2)
	    (> (bid-amount entry1) (bid-amount entry2)))
	  (get-bids item))))
    (if (> (length sortbids) 0)
	(car sortbids)
	null)))

(define (bidbot? bid) (pair? bid))
(define (bidbot-amount bid) (car bid))
(define (bidbot-proc bid) (cdr bid))

;;; Install the bidbot proc for bidder and item, where
;;; the current high bid is highest-bid.  Evaluates to
;;; the value of the bidbot procedure on the highest-bid.

(define (install-bidbot! bidder item highest-bid proc)
  (let ((newbid (proc highest-bid)))
    (if newbid
	(begin
	  (reset-bidbots! item)
	  (table-insert! bids (list bidder item (cons newbid proc)))
	  (printf "~a is now the high bidder for ~a: ~a~n" bidder item newbid)
	  (reevaluate-bidbots item newbid))
	(table-insert! bids (list bidder item (cons #f proc))))
    newbid))

;;;
;;; We have modified place-bid to place either plain value bids
;;; or bidbot bids (bid is a procedure)
;;;

(define (place-bid bidder item bid)
  (let ((bidder-entry (table-entries (table-select bidders 'name (make-string-selector bidder))))
	(item-entry (table-entries (table-select items 'item-name (make-string-selector item)))))
    (if (= (length bidder-entry) 0)
	(printf "~a is not a legitimate bidder!" bidder)
	(if (> (length bidder-entry) 1)
	    (printf "Multiple matching bidders: ~a" bidder-entry)
	    (if (= (length item-entry) 0)
		(printf "The ~a is not for sale!" item)
		(if (> (length item-entry) 1)
		    (printf "Multiple matching items: ~a" item-entry)
		    (let ((highest-bid (get-highest-bid item)))
		      (if (procedure? bid) ;;; its a bid bot
			  (install-bidbot! bidder item
					   (if (null? highest-bid) 0 (bid-amount highest-bid))
					   bid) ;;; The bidbot procedure
			  (begin ;;; not a bid bot
			    (if (> bid (bid-amount highest-bid))
				(begin
				  (printf "~a is now the high bidder for ~a: ~a~n" bidder item bid)
				  (insert-bid bidder item bid)
				  (reset-bidbots! item)
				  (reevaluate-bidbots item bid)
				  (void))
				(printf "Bid amount does not exceed previous highest bid: ~a~n"
					(bid-amount highest-bid))))))))))))

(define (end-auction!)
  (map
    (lambda (item-entry)
      (let ((item-name (get-nth item-entry (find-field-number items 'item-name))))
	(let ((high-bid (get-highest-bid item-name)))
	  (if (null? high-bid)
	      (begin
		(printf "No bids on ~a.~n" 
			(get-nth item-entry (find-field-number items 'item-name)))
		0)
	      (begin
		(printf "Congratulations ~a!  You have won the ~a for $~a.~n"
			(get-nth high-bid (find-field-number bids 'bidder-name))
			item-name
			(get-nth high-bid (find-field-number bids 'amount)))
		(set! university-funds 
		      (+ university-funds 
			 (get-nth high-bid (find-field-number bids 'amount)))))))))
    (table-entries items))
  (if (>= university-funds 0)
      (printf "Wahoo!  The University is no longer in deficit an has $~a to spend.~n"
	      university-funds)
      (printf "The University still has a deficit of $~a.~n"
	      university-funds)))

;;; setup-tables puts some entries in the tables for testing
(define (setup-tables)
   ;;; Clear all the tables
  (set! bidders (make-new-table (list 'name 'email)))
  (set! items (make-new-table (list 'item-name 'description)))
  (set! bids (make-new-table (list 'bidder-name 'item-name 'amount)))

  (add-bidder "Tim Koogle" "tk@yahoo.com")
  (add-bidder "Katie Couric" "katie@nbc.com")
  (add-bidder "Dave Matthews" "dave@dmb.com")

  (post-item "SEAS" "School of Engine and Apple Science")
  (post-item "CLAS" "School of (Liberal) Arts and Sciences")
  (post-item "AFC" "Aquatic and Fritters Center")
  (post-item "MEC" "Multimedia Enhanced Classroom Building")

  (insert-bid "Tim Koogle" "SEAS" 10000000)
  (insert-bid "Dave Matthews" "CLAS" 2000000)
  (insert-bid "Katie Couric" "SEAS" 15000000)
  (insert-bid "Tim Koogle" "SEAS" 12000000)) 

;;; Initially, the University has a $12M deficit.
(define university-funds -12000000)