;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; Copyright (c) Wesley H. Huang.  All rights reserved.
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; This is a pretty minimal testing function.  Remember that this does
; not do an extensive test of your code, it will just run a few
; examples to make sure that your code basically works.  You can feel
; free to add test inputs, or particularly for this assignment, it's
; pretty easy to write your own testing functions (albeit without
; error trapping code).
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; Instructions:
;
; * This file will load the "data.scm" file and your source code file
;   from the current directory, so it's easiest if you put them all in
;   one place.
;
; * Once loaded, call the function "test" with your filename, eg.
;   (test "whuang") will load and test the file "whuang.scm"
;
; * Make sure that your code loads the "dtree.scm" file
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(load "data")

(define (test fname)
  (let ((te)
	(results '()))
    (newline)
    (newline)
    (set! te (the-environment))
    (if (condition? (ignore-errors (lambda () (load fname te))))
        (begin
          (newline)
          (display "Error reading file: ")
	  (display fname)
          (newline))
        (begin
          (newline)
          (display "Loading file: ")
          (display fname)
          (newline)

	  ;
	  ; Problem 1
	  ;
	  (display "

Problem 1
---------
")
	  (let ((is-defined (ignore-errors (lambda () (procedure? learn-dt)))))
	    (if (or (condition? is-defined)
		    (not is-defined))
		(begin
		  (display "The learn-dt procedure is not defined: ")
		  (display is-defined)
		  (newline))
		(test-ldt learn-dt)))

	  ;
	  ; Problem 2
	  ;
	  (display "

Problem 2
---------
")
	  (let ((is-defined (ignore-errors (lambda () (procedure? discretize)))))
	    (if (or (condition? is-defined)
		    (not is-defined))
		(begin
		  (display "The discretize procedure is not defined: ")
		  (display is-defined)
		  (newline))
		(test-disc discretize learn-dt)))))))

(define (make-tester fname inputs answers compare grade message)
  (define (test-fn fn)
    (define (test-input inp ans results)
      (newline)
      (if (null? inp)
	  (reverse results)
	  (let ((res (ignore-errors (lambda () (apply fn (car inp))))))
	    (if (condition? res)
		(begin
		  (display "Error evaluating ")
		  (display-call fname (car inp))
		  (newline)
		  (display "Error: ")
		  (display res)
		  (test-input (cdr inp) (cdr ans) (cons 'error results)))
		(begin
		  (display "TEST #")
		  (display (length results))
		  (display ": ")
		  (display-call fname (car inp))
		  (display "\nRETURNED: ")
		  (display res)
		  (newline)
		  (let ((cmp (ignore-errors
			      (lambda () (compare res (car ans))))))
		    (cond
		     ; error in checking answer
		     ((condition? cmp)
		      (display "ERROR: your answer is probably not in the correct form\n")
		      (display "The answer is: ")
		      (display (car ans))
		      (newline)
		      (test-input (cdr inp) (cdr ans)
				  (cons 'form-error results)))
		     ; wrong answer
		     ((equal? cmp #f)
		      (display "WRONG; the correct answer is: ")
		      (display (car ans))
		      (newline)
		      (test-input (cdr inp) (cdr ans)
				  (cons 'wrong results)))
		     ; right answer
		     (else
		      (display "CORRECT\n")
		      (test-input (cdr inp) (cdr ans)
				  (cons 'ok results))))))))))

    (display message)
    (let (( g (grade (test-input inputs answers '()))))
      (display "\nScore for ")
      (display fname)
      (display " is: ")
      (display g)
      g))
  test-fn)


(define (display-call fname args)
  (define (print-args a)
    (if (not (null? a))
	(begin 
	  (display " '")
	  (write (car a))
	  (print-args (cdr a)))))

  (display "(")
  (display fname)
  (print-args args)
  (display ")"))

(define (prorate-for tot)
  (define (grade-fn results)
    (let ((no-tests (length results))
	  (no-right (length (list-transform-positive results
			      (lambda (x) (equal? x 'ok))))))
      (display "Total points for this question: ")
      (display tot)
      (newline)
      (round (* tot (/ no-right no-tests)))))
  grade-fn)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define (equiv-value-dts vdt1 vdt2)
  (if (null? vdt1)
      #t
      (and (dt-equal? (cadar vdt1)
		      (let ((av (assoc (caar vdt1) vdt2)))
			(if (null? av)
			    '()
			    (cadr av))))
	   (equiv-value-dts (cdr vdt1) vdt2))))

(define (dt-equal? dt1 dt2)
  (or (equal? dt1 dt2)
      (and (list? dt1)
	   (> (length dt1) 0)
	   (list? dt2)
	   (> (length dt2) 0)
	   (equal? (car dt1) (car dt2))
	   (= (length dt1) (length dt2))
	   ; check to make sure everything in dt1 is in dt2
	   (equiv-value-dts (cdr dt1) (cdr dt2))
	   ; check to make sure everything in dt2 is in dt1
	   (equiv-value-dts (cdr dt2) (cdr dt1)))))
       

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define learn-dt-inputs 
  (list (list play-tennis-tdata)
	(list restaurant-tdata)))
(define learn-dt-answers
  '((1 (normal yes) (high (0 (overcast yes) (sunny no) (rain no))))
    (4 (none no) (full (3 (no no) (yes (8 (burger yes) (italian no) (thai (2 (no no) (yes yes))))))) (some yes))))

(define test-ldt
  (make-tester "learn-dt"
	       learn-dt-inputs
	       learn-dt-answers
	       dt-equal?
	       (prorate-for (length learn-dt-inputs))
	       "
Testing your learn-dt procedure on the play-tennis and restaurant examples...
"
))

(define (test-disc discretize ldt)
  (display

"Testing your discretize procedure by training on census-tdata and
then testing it on census-test1.  (For this test, I'm using your
learn-dt procedure, whereas when it comes to the actual testing, I'll
use mine.)  When I test your procedure, I'll give it training data and
test data that you haven't seen before (but will be drawn from the
same data set as the training and test data sets).

This test essentially calls: 

  (test-disc-dt discretize
                (learn-disc-dt discretize census-tdata)
                census-test1)

which will print out some results for you...
")
  (let ((res (ignore-errors
	      (lambda ()   
		(test-disc-dt discretize
			      (ldt (map (lambda (x) 
					       (list (car x) 
						     (discretize (cadr x))))
					     census-tdata))
			      census-test1)))))
    (if (condition? res)
	(begin 
	  (display "Error: ")
	  (display res)
	  (newline)))))