;;; Michael Wollowski
;;; 5.ss

(define (rl) (load "5.ss"))

(define snlist-recur
  (lambda (flist fatom init)
    (letrec ([helper (lambda (l)
		       (cond [(null? l) init]
			     [(list? (car l)) (flist (helper (car l))
						     (helper (cdr l)))]
			     [else (fatom (car l) (helper (cdr l)))]))])
      helper)))


(define foo (snlist-recur (lambda (x y) (if (null? y) x y)) (lambda (x y) (if (null? y) x y)) '()))

(define sn-list-sum (snlist-recur + + 0))

(define paren-count (snlist-recur + (lambda (x y) y) 2))

(define sn-list-map (lambda (f ls)
		      ((snlist-recur cons
				     (lambda (x y)
				       (cons (f x) y))
				     '())
		       ls)))





(define sn-list-reverse (snlist-recur (lambda (x y)
					(append y (list x)))
				      (lambda (x y)
					(append y (list x)))
				      '()))

(define sn-list-occur (lambda (e ls)
			((snlist-recur +
				       (lambda (x y)
					 (+ (if (eq? x e)
						1
						0)
					    y))
				       0)
			 ls)))


(define depth (snlist-recur (lambda (x y)
			      (if (>= x y)
				  (+ x 1)
				  y))
			    (lambda (x y)
			      y)
			    1))

;;; This is a better solution.
(define occurs-free?
  (lambda (var expr)
    (let ([free? (lambda (e) (occurs-free? var e))])
      (cond [(symbol? expr) (eqv? var expr)]
	    [(eqv? (car expr) 'lambda)
	     (and (not (member var (cadr expr)))
		  (free? (cddr expr)))]
	    [(eqv? (car expr) 'if)
	     (ormap free? (cdr expr))]
	    [(eqv? (car expr) 'let)
	     (free? (let->lambda expr))]
	    [(eqv? (car expr) 'let*)
	     (free? (let*->let expr))]
	    [(eqv? (car expr) 'set!)
	     (free? (cddr expr))]
	    [else (ormap free? expr)]))))


;;; This one is more complex.
(define occurs-free?
  (lambda (var exp)
    (cond [(null? exp) #f]
	  [(symbol? exp) (eqv? var exp)]
	  [(eqv? (car exp) 'lambda)
	   (and (not (memv var (cadr exp)))
		(occurs-free? var (caddr exp)))]
	  [(eqv? (car exp) 'let)
	   (occurs-free? var (let->application exp))]
	  [(eqv? (car exp) 'let*)
	   (occurs-free? var (let*->let exp))]
	  [(eqv? (car exp) 'if)
	   (or (occurs-free? var (cadr exp))
	       (occurs-free? var (caddr exp))
	       (and (not (null? (cdddr exp)))
		    (occurs-free? var (cadddr exp))))]
	  [(eqv? (car exp) 'set!)
	   (and (not (eqv? var (cadr exp)))
		(occurs-free? var (caddr exp)))]
	  [else (or (occurs-free? var (car exp))
		    (occurs-free? var (cdr exp)))])))


(define let->application
  (lambda (let-expression)
    (let ((args (cadr let-expression))
	  (body (caddr let-expression)))
      (cons (list 'lambda (make-args args) body)
	    (make-vals args)))))

(define make-args
  (lambda (list)
    (map car list)))

(define make-vals
  (lambda (list)
    (map cadr list)))

(define let*->let
  (lambda (expression)
    (let ([var-defs (cadr expression)]
	  [body (caddr expression)])
      (if (null? var-defs)
	  (list 'let '() body)
	  (make_lets var-defs body)))))

(define make_lets
  (lambda (var-defs body)
    (if (null? var-defs)
	body
	(list 'let (list (car var-defs)) (make_lets (cdr var-defs) body)))))



(define occurs-bound?
  (lambda (var exp)
    (cond [(symbol? exp) #f]
	  [(null? exp) #f]
	  [(eqv? (car exp) 'lambda)
	   (or (occurs-bound? var (caddr exp))
	       (and (memv var (cadr exp))
		    (occurs-free? var (caddr exp))))]
	  [(eqv? (car exp) 'let)
	   (occurs-bound? var (let->application exp))]
	  [(eqv? (car exp) 'let*)
	   (occurs-bound? var (let*->let exp))]
	  [(eqv? (car exp) 'if)
	   (or (occurs-bound? var (cadr exp))
	       (occurs-bound? var (caddr exp))
	       (and (not (null? (cdddr exp)))
		    (occurs-bound? var (cadddr exp))))]
	  [(eqv? (car exp) 'set!)
	   (or (occurs-bound? var (caddr exp))
	       (and (eqv? var (cadr exp))
		    (occurs-free? var (caddr exp))))]
	  [else (or (occurs-bound? var (car exp))
		    (occurs-bound? var (cdr exp)))])))



;(define connected?
;  (lambda (g)
;    #t))


(define gr '((a (b c)) (b (a)) (c (a)) (d ())))

(define connected?
  (lambda (g)
    (cond [(null? g)]
	  [(and (null? (cdr g))
		(null? (cdar g)))]
	  [else (let* ([nodes (map car g)]
		       [startEndPoints (make_start_end_points nodes)])
		  (paths? startEndPoints g))])))

(define make_start_end_points
  (lambda (l)
    (if (null? (cdr l))
	'()
	(append (map (lambda (x) (list (car l) x)) (cdr l))
		(make_start_end_points (cdr l))))))


(define paths?
  (lambda (SEPoints g)
    (if (null? SEPoints)
	#t
	(and (path? (cadar SEPoints) g (list (caar SEPoints)) '())
	     (paths? (cdr SEPoints) g)))))


(define path?
  (lambda (endPoint g openqueue closedqueue)
    (cond [(null? openqueue) #f]
	  [(eq? (car openqueue) endPoint) #t]
	  [else (path? endPoint
		       g
		       (add_to_open (get_neighbors (car openqueue) g) openqueue closedqueue)
		       (cons (car openqueue) closedqueue))])))
		       

(define add_to_open
  (lambda (nodes open closed)
    (cond [(null? nodes) (cdr open)]
	  [(or (memq (car nodes) open)
	       (memq (car nodes) closed))
	   (add_to_open (cdr nodes) open closed)]
	  [else (append (add_to_open (cdr nodes) open closed) (list (car nodes)))])))

(define add_to_open_tail
  (lambda (nodes open closed accu)
    (cond [(null? nodes) (append (cdr open) accu)]
	  [(or (memq (car nodes) open)
	       (memq (car nodes) closed))
	   (add_to_open_tail (cdr nodes) open closed accu)]
	  [else (add_to_open_tail (cdr nodes) open closed (cons (car nodes) accu))])))


(define get_neighbors
  (lambda (e g)
    (cond [(null? g) '()]
	  [(eq? e (caar g)) (cadar g)]
	  [else (get_neighbors e (cdr g))])))


(define free-vars
  (case-lambda
   [(exp) (free-vars exp '() '())]
   [(exp free bound)
    (cond [(null? exp) free]
	  [(symbol? exp)
	   (if (memq exp bound)
	       free
	       (merge exp free))]
	  [(eq? (car exp) 'lambda)
	   (free-vars (cddr exp) free (merge (cadr exp) bound))]
	  [(null? (cdr exp)) (free-vars (car exp) free bound)]
	  [else (merge (free-vars (car exp) free bound)
			(free-vars (cadr exp) free bound))])]))


(define bound-vars
  (case-lambda
   [(exp) (bound-vars exp '())]
   [(exp bound)
    (cond [(null? exp) '()]
	  [(symbol? exp)
	   (if (memq exp bound)
	       (list exp)
	       '())]
	  [(eq? (car exp) 'lambda)
	   (bound-vars (cddr exp) (append (cadr exp) bound))]
	  [(null? (cdr exp)) (bound-vars (car exp) bound)]
	  [else (append (bound-vars (car exp) bound)
			(bound-vars (cadr exp) bound))])]))


 (define merge
   (lambda (x y)
     (cond [(null? x) y]
	   [(symbol? x) (if (memq x y)
			    y
			    (cons x y))]
	   [else (merge (car x) (merge (cdr x) y))])))