(define (field? maze x y)
  (if (= y 0)
      (if (= x 0)
          (caar maze)
          (field? (cons (cdar maze) (cdr maze)) (- x 1) y))
      (field? (cdr maze) x (- y 1))))

(define (turnleft state)
  (define (change_left orient)
    (cond
      ((equal? orient 'north) 'west)
      ((equal? orient 'east) 'north)
      ((equal? orient 'south) 'east)
      (else 'south)))
  (list (car state) (cadr state) (change_left (caddr state))))

(define (new-maze maze x y value)
  (define (new_maze maze x y value newmaze)
    (if (= y 0)
        (if (= x 0)
            (cons (cons value (cdar maze)) (cdr maze))
            (cons (cons (caar maze) (car (new_maze (cons (cdar maze) (cdr maze)) (- x 1) y value newmaze))) (cdr (new_maze (cons (cdar maze) (cdr maze)) (- x 1) y value newmaze))))
        (cons (car maze) (new_maze (cdr maze) x (- y 1) value newmaze))))
  (new_maze maze x y value '())
  )


(define (putmark state)
  (define (put_mark maze x y)
    (new-maze maze x y (+ (field? maze x y) 1)))
  (list (put_mark (car state) (caadr state) (cadadr state)) (cadr state) (caddr state)))

(define (getmark state)
  (define (get_mark maze x y)
    (if (> (field? maze x y) 0)
        (new-maze maze x y (- (field? maze x y) 1))
        (new-maze maze x y (field? maze x y) )
        ))
  (list (get_mark (car state) (caadr state) (cadadr state)) (cadr state) (caddr state)))

(define (north?? state)
  (if (equal? (caddr state) 'north)
      #t
      #f))

(define (mark?? state)
  (if (> (field? (car state) (caadr state) (cadadr state)) 0)
      #t
      #f))

(define (wall?? state)
  (cond
    ((equal? (caddr state) 'north) (equal? (field? (car state) (caadr state) (- (cadadr state) 1)) 'w))
    ((equal? (caddr state) 'west) (equal? (field? (car state) (- (caadr state) 1) (cadadr state)) 'w))
    ((equal? (caddr state) 'south) (equal? (field? (car state) (caadr state) (+ (cadadr state) 1)) 'w))
    (else (equal? (field? (car state) (+ (caadr state) 1) (cadadr state)) 'w))))

(define (my-step state)
  (if (not (wall?? state))
      (cond
        ((equal? (caddr state) 'north) (list (car state) (list (caadr state) (- (cadadr state) 1)) 'north))
        ((equal? (caddr state) 'west) (list (car state) (list (- (caadr state) 1) (cadadr state)) 'west))
        ((equal? (caddr state) 'south) (list (car state) (list (caadr state) (+ (cadadr state) 1)) 'south))
        (else (list (car state) (list (+ (caadr state) 1) (cadadr state)) 'east)))
      state
      ))

(define (simulate state expr program limit threshold)

  (define actions 0)

  (define (inc-actions)
    (set! actions (+ actions 1)))

  (define my-limit 0)

  (define (inc-limit)
           (set! my-limit (+ my-limit 1)))

  (define (dec-limit)
           (set! my-limit (- my-limit 1)))

  (define my-threshold 0)

  (define (dec-threshold)
    (set! my-threshold (- my-threshold 1)))

  (define kill-me #f)

  (define (kill-me-now)
    (set! kill-me #t))

  (define (my-simulate state expr program)

  (define (turn-left)
    (inc-actions)
    (dec-threshold)
    (if (= my-threshold -1)
        (kill-me-now))
        (turnleft state)
    )

  (define (put-mark)
    (inc-actions)
    (dec-threshold)
    (if (= my-threshold -1)
        (kill-me-now))
    (putmark state)
    )

  (define (get-mark)
    (cond
    ((mark?? state) (inc-actions) (dec-threshold) (if (= my-threshold -1) (kill-me-now)) (getmark state))
    ((not (mark?? state)) (kill-me-now) state)
    )
    )

  (define (step)
    (cond
      ((not (wall?? state)) (inc-actions) (dec-threshold) (if (= my-threshold -1) (kill-me-now)) (my-step state))
      ((wall?? state) (kill-me-now) state)
    )
    )

  (define (wall?)
    (wall?? state))

  (define (mark?)
    (mark?? state))

  (define (north?)
    (north?? state))

  (define (my-if expr)
    (cond
      ((equal? expr 'wall?) (wall?))
      ((equal? expr 'mark?) (mark?))
      (else (north?))))

   (define (execute-if procedure)
     (if (my-if (cadr procedure))
         (caddr procedure)
         (cadddr procedure)))

  (define (find-procedure program procedure)
        (if (not (null? program))
            (cond
              ((equal? (cadar program) procedure) 'procedure)
                (else (if (null? (cdr program))
                    'not-procedure
                    (find-procedure (cdr program) procedure)))
                )
            'not-procedure
        ))

   (define (find-procedure2 program procedure)
        (if (not (null? program))
            (cond
              ((equal? (cadar program) procedure) (dec-limit) (list (caddar program) 'end-proc))
                (else (if (null? (cdr program))
                    'not-procedure
                    (find-procedure2 (cdr program) procedure)))
                )
            'not-procedure
        ))

  (define (execute-procedure procedure)
    (if (not kill-me)
        (if (= my-limit -1)
            state
            (if (list? procedure)
                (if (not (null? procedure))
                    (if (equal? (car procedure) 'if)
                        (my-simulate state (execute-if procedure) program)
                        (my-simulate (execute-procedure (car procedure)) (cdr procedure) program))
                    state)
                (if (equal? (find-procedure program procedure) 'procedure)
                    (my-simulate (my-simulate state (find-procedure2 program procedure) program) '() program)
                    (my-simulate state procedure program))
                )
            )
        state)
    )

  (cond
    ((equal? kill-me #t) state)
    ((equal? expr 'end-proc) (inc-limit) state)
    ((equal? expr '()) state)
    ((equal? expr 'step) (step))
    ((equal? expr 'turn-left) (turn-left))
    ((equal? expr 'put-mark) (put-mark))
    ((equal? expr 'get-mark) (get-mark))
    (else (execute-procedure (if (not (equal? expr '())) expr '())))))

  (set! my-limit limit)
  (set! my-threshold (cadddr threshold))

  (let ((end-state (my-simulate state expr program)))
    (append (list actions) (list end-state)))

  )

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;MERGE SORT

(define split (lambda (s)
                (cond
                  ((null? (cdr s)) (cons s '()))
                  ((null? (cddr s)) (cons (list (car s)) (cdr s)))
                  (else (let* (
                               (ab (split (cddr s)))
                               (a (car ab))
                               (b (cdr ab))
                              )
                          (cons (cons (car s) a) (cons (cadr s) b))
                          )))))

(define (merge a b)
  (cond
    ((null? a) b)
    ((null? b) a)
    ((comparator (car a) (car b)) (cons (car a) (merge (cdr a) b )))
    (else (merge b a ))))

(define my-list
  '(((18 7 6 20) ((procedure start (put-mark (if wall? turn-left step) start)))) ((8 5 5 2) ((procedure start (step step step put-mark))))))

(define (comparator a b)
  (let ((value1 (car a)) (value2 (car b)))
    (if (< (car value1) (car value2))
        #t
        (if (> (car value1) (car value2))
            #f
            (if (< (cadr value1) (cadr value2))
                #t
                (if (> (cadr value1) (cadr value2))
                    #f
                    (if (< (caddr value1) (caddr value2))
                        #t
                        (if (> (caddr value1) (caddr value2))
                            #f
                            (if (< (cadddr value1) (cadddr value2))
                                #t
                                (if (> (cadddr value1) (cadddr value2))
                                    #f
                                    #t
                                    )
                                )
                            )
                        )
                    )
                )
        )
    )
  )
  )

(define (merge-sort s)
  (cond
    ((null? s) s)
    ((null? (cdr s)) s)
    (else (let* (
                 (ab (split s))
                 (sa (merge-sort (car ab)))
                 (sb (merge-sort (cdr ab)))
                )
            (merge sa sb)))))

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

(define (diff-row o d)
  (if (null? (cdr o))
      (if (equal? (car o) 'w)
          0
          (abs (- (car o) (car d))))
      (+ (if (equal? (car o) 'w) 0 (abs (- (car o) (car d)))) (diff-row (cdr o) (cdr d)))
      ))

(define (diff-of-fields output-maze desired-maze)
  (if (null? (cdr output-maze))
      (diff-row (car output-maze) (car desired-maze))
      (+ (diff-row (car output-maze) (car desired-maze)) (diff-of-fields (cdr output-maze) (cdr desired-maze)))
  ))

(define (man-dist output-state desired-state)
  (if (equal? (caddr output-state) (caddr desired-state))
      (+ (abs (- (caadr output-state) (caadr desired-state))) (abs (- (cadadr output-state) (cadadr desired-state))))
      (+ (+ (abs (- (caadr output-state) (caadr desired-state))) (abs (- (cadadr output-state) (cadadr desired-state)))) 1))
  )

(define (length-of-prg prg)
  (if (null? prg)
      0
      (+ (length-of-proc (car prg)) (length-of-prg (cdr prg))))
  )

(define (length-of-proc proc)
  (if (null? proc)
      0
      (if (list? (car proc))
          (+ (length-of-proc (car proc)) (length-of-proc (cdr proc)))
          (if (or (equal? (car proc) 'procedure) (equal? (car proc) 'if))
              (length-of-proc (cdr proc))
              (+ (length-of-proc (cdr proc)) 1))
          )
      )
  )

(define (return-value prg pair stack_size threshold)
  (let ((output-state (cadr (simulate (caar pair) 'start prg stack_size threshold))) (desired-state (cadar pair)) (len (car (simulate (caar pair) 'start prg stack_size threshold))))
              (list (diff-of-fields (car output-state) (car desired-state)) (man-dist output-state desired-state) (length-of-prg prg) len)
              )
  )

(define (return-final-value prg pairs stack_size threshold)
  (if (null? (cdr pairs))
      (return-value prg (list (car pairs)) stack_size threshold)
      (let ((value1 (return-value prg (list (car pairs)) stack_size threshold)) (value2 (return-final-value prg (cdr pairs) stack_size threshold)))
        (list (+ (car value1) (car value2)) (+ (cadr value1) (cadr value2)) (caddr value1) (+ (cadddr value1) (cadddr value2))))
        )
  )

(define (check-threshold value threshold)
  (if (> (car value) (car threshold))
      #f
      (if (> (cadr value) (cadr threshold))
          #f
          (if (> (caddr value) (caddr threshold))
              #f
              (if (> (cadddr value) (cadddr threshold))
                  #f
                  #t
                  )
              )
          )
      )
  )

(define (evaluate prgs pairs threshold stack_size)

  (define final-list '())

  (define (push o)
    (let ((s final-list))
      (set! final-list (cons o s))))

  (define (my-evaluate prgs pairs threshold stack_size)
    (if (null? (cdr prgs))
        (let ((final-value (return-final-value (car prgs) pairs stack_size threshold)))
          (if (check-threshold final-value threshold)
              (push (list final-value (car prgs)))
              )
        )
        (cond
          (else (my-evaluate (list (car prgs)) pairs threshold stack_size) (my-evaluate (cdr prgs) pairs threshold stack_size))
          )
    )
    )
  (cond
    (else (my-evaluate prgs pairs threshold stack_size) (merge-sort final-list))
  )
  )

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



;((w w w w w)   ((w w w w w)
 ;(w 1 w 1 w)    (w 0 w 1 w)
 ;(w 3 0 0 w)    (w 1 0 1 w)
 ;(w w w w w))   (w w w w w))

(define get-maze
'(
(w w w w w w)
(w 0 w 0 w w)
(w 0 w 0 0 w)
(w 0 0 0 w w)
(w w w w w w)
)
)

(define right-hand-rule-prg
  '(
    (procedure start
      ( turn-right
        (if wall?
           ( turn-left
             (if wall?
                 (turn-left
                     (if wall?
                        turn-left
                        step
                     )
                 )
                 step
              )
           )
           step
        )
        put-mark
        start
      )
    )
    (procedure turn-right (turn-left turn-left turn-left))
  )
)

(define prgs
'(
   (
      (procedure start
         (turn-right (if wall? (turn-left
             (if wall? (turn-left (if wall? turn-left step)) step)) step)
                 put-mark start )
      )
      (procedure turn-right (turn-left turn-left turn-left))
  )
  (
      (procedure start  (put-mark (if wall? turn-left step) start))
  )
  (
      (procedure start (step step step put-mark))
  )
)
)

(define pairs
'(
  (
   (((w w w w w w)
     (w 0 w 0 w w)
     (w 1 w 0 0 w)
     (w 1 0 0 w w)
     (w w w w w w))
     (1 3) south)

   (((w w w w w w)
     (w 0 w 0 w w)
     (w 0 w 0 0 w)
     (w 0 0 0 w w)
     (w w w w w w))
     (1 1) north)
   )
   (
   (((w w w w w w)
     (w 0 w 0 w w)
     (w 0 w 2 0 w)
     (w 1 3 0 w w)
     (w w w w w w))
     (3 3) north)

   (((w w w w w w)
     (w 0 w 0 w w)
     (w 0 w 0 0 w)
     (w 0 0 0 w w)
     (w w w w w w))
     (1 1) north)
  ))
 )