#lang racket

(provide hours simulate-lite tm1 config1 config2 ins ins-c-state
         ins-c-symbol ins-n-state ins-n-symbol ins-dir tm-reverse
         i-match? i-lookup conf conf-state conf-ltape conf-symbol
         conf-rtape halted? change-state write-symbol normalize
         shift-head-left shift-head-right next-config tm-parity
         tm-sort )

; Please do not modify the lines above this comment.
; ********************************************************
; CS 2010 HW #3  DUE Sunday, 2/15/2026 at 11:59 pm
;                            via Gradescope
; ****************************************************************
; Name:
; Email address:
; ****************************************************************

; Unless the problem specifies otherwise:
; (a) You may solve the problem using any method and any Racket 
;     constructs (*except* mutators, that is, set! and its relatives.)
; (b) You may write auxiliary procedure(s) in addition to the one(s)
;     specified in the problem.  
;     Please include a comment for each one specifying what
;     it does and giving one or more examples of it.
; (c) Please make your code as clear and readable as possible.

; The topics of this assignment are:
; a simulator for Turing machines and writing Turing machine programs.

; ****************************************************************
; ** problem 0 ** (1 easy point)

; Modify the following definition to reflect the number of hours you
; spent on this assignment.

(define hours 0)

; ****************************************************************
; Turing machines were described in the lectures; see also the lecture
; notes.  Here is a top-level procedure to simulate a Turing machine
; starting from a given configuration until either it halts or it has
; executed n steps. The procedure returns the list of the successive
; configurations of the computation, starting with the initial one.
; The length of the list of configurations is one more than the number
; of steps taken by the machine.

; simulate : (listof ins) conf number -> (listof conf)
; Note: you cannot call this function until you have defined
; halted? and next-config in the problems below.
(define (simulate mach config n) 
  (cond
    [(<= n 0) (list config)]
    [(halted? mach config) (list config)]
    [else
     (cons config
           (simulate
            mach
            (next-config mach config)
            (- n 1)))]))

; mach is a representation of a Turing machine
; config is a representation of a configuration of the machine
; n is the maximum number of steps to simulate

; The procedures halted? and next-config will be written by you in the
; problems below; you will then have a complete Turing machine
; simulator.

; The test solutions at the bottom specify a number of steps, n, that
; the simulation should run before stopping.  Your code may in fact
; need more steps to solve the given problem.  The auto-grade program
; will account for this, allowing roughly twice as many steps for your
; code to run.  Still, there is a limit.  We have yet to solve the
; halting problem.

; (simulate-lite tm config n) is like simulate, but does not return
; the intermediate states - just the final tape contents.

; simulate-lite : (listof ins) conf number -> list-or-timeout
(define (simulate-lite tm config n) 
  (cond
    ((<= n 0) 'timeout)
    ((halted? tm config) (list (conf-ltape config)
    			       (conf-symbol config)
			       (conf-rtape config)))
    (else
     (simulate-lite
      tm (next-config tm config) (- n 1)))))

; ****************************************************************
; Turing machine representation.

; A Turing machine is represented as a list of instructions, 
; where each instruction is a 5-tuple, represented as a struct
; defined as follows:

(struct ins (c-state c-symbol n-state n-symbol dir) #:transparent) 

; The fields represent the following components of an instruction:
; current state, current symbol, new state, new symbol, and move direction

; The current state and new state are Racket symbols, the current
; symbol and new symbol are Racket symbols OR non-negative integers
; and the move direction must be either the symbol 'L or the symbol
; 'R, representing a move to the left or right, respectively.

; Example

(define i1 (ins 'q1 0 'q3 1 'L))

; creates an instruction with current state 'q1, current symbol 0, new
; state 'q3, new symbol 1, and move direction 'L, and names it i1.

; Because we've made ins "transparent", its field values
; will be printed out.
; > i1
; (ins 'q1 0 'q3 1 'L)

; We can access the components of i1 via the structure selectors:
; (ins-c-state i1) => 'q1
; (ins-c-symbol i1) => 0
; (ins-n-state i1) => 'q3
; (ins-n-symbol i1) => 1
; (ins-dir i1) => 'L

; Examples:

; a Turing machine that when started in state 'q1 on the leftmost of a
; string of 0's and 1's changes all the 0's to 1's and all the 1's to
; 0's and then returns the head to the leftmost symbol and halts.

(define tm1 
  (list
   ;; Initial state: q1. Move right, switching
   ;; 0s to 1s and 1s to 0s.
   (ins 'q1 0 'q1 1 'R)
   (ins 'q1 1 'q1 0 'R)
   ;; Once off the edge (onto blank cell 'b), move
   ;; back left and switch to q2.
   (ins 'q1 'b 'q2 'b 'L)
   ;; State q2: returning head to original position.
   ;; Move left (making no changes) until blank.
   (ins 'q2 0 'q2 0 'L)
   (ins 'q2 1 'q2 1 'L)
   ;; Upon seeing blank, move right (to first occupied cell)
   ;; and halt (change to state q3).
   (ins 'q2 'b 'q3 'b 'R)))

; Here is a Turing machine that copies its tape to itself.
; That is, starting with a sequence like '(1 1 0 1), it
; halts with the sequence '(1 1 0 1 c 1 1 0 1).

(define tmcopy
  (list
   ;; Initial state q1: move right to first blank
   ;; cell, then write a 'c there. Move back to
   ;; last non-blank cell, transitioning to q2.
   (ins 'q1 0 'q1 0 'R)        
   (ins 'q1 1 'q1 1 'R)        
   (ins 'q1 'b 'q2 'c 'L)
   ;; State q2: Move left, back to beginning of tape,
   ;; then transition to q3.
   (ins 'q2 0 'q2 0 'L)        
   (ins 'q2 1 'q2 1 'L)        
   (ins 'q2 'b 'q3 'b 'R)
   ;; State q3: Replace 0 with 'd or 1 with 'e.
   ;;   If 0: Use q4 to add a "0" at end of tape.
   ;;   If 1: Use q5 to add a "1" at end of tape.
   ;; Transition to q7 if end of sequence reached.
   (ins 'q3 0 'q4 'd 'R)       
   (ins 'q3 1 'q5 'e 'R)       
   (ins 'q3 'c 'q7 'c 'L)
   ;; State q4: Go to end of tape and append a 0,
   ;; then use q6 to return to state q3 where we
   ;; left off.
   (ins 'q4 0 'q4 0 'R) 
   (ins 'q4 1 'q4 1 'R) 
   (ins 'q4 'c 'q4 'c 'R) 
   (ins 'q4 'b 'q6 0 'L)
   ;; State q5: Go to end of tape and append a 1,
   ;; then use q6 to return to state q3 where we
   ;; left off.
   (ins 'q5 0 'q5 0 'R) 
   (ins 'q5 1 'q5 1 'R) 
   (ins 'q5 'c 'q5 'c 'R) 
   (ins 'q5 'b 'q6 1 'L)
   ;; State q6: Return leftward to where q3 last was,
   ;; detected via a d or an e. Based on whether we find
   ;; a d or an e, rewrite back to 0 or 1, respectively.
   (ins 'q6 0 'q6 0 'L) 
   (ins 'q6 1 'q6 1 'L) 
   (ins 'q6 'c 'q6 'c 'L) 
   (ins 'q6 'd 'q3 0 'R) 
   (ins 'q6 'e 'q3 1 'R)
   ;; State q7: Our job is done; move back to start of tape
   ;; then enter q8 to halt.
   (ins 'q7 0 'q7 0 'L) 
   (ins 'q7 1 'q7 1 'L) 
   (ins 'q7 'b 'q8 'b 'R)
   ))

; ****************************************************************
; ** problem 1 (10 points)

; Write the following two procedures.  Remember to use the instruction
; selectors: ins-c-state, ins-c-symbol, ins-n-state, ins-n-symbol,
; ins-dir

; (i-match? state symbol inst)

; returns #t if state and symbol are equal to the state and symbol of
; instruction inst; otherwise returns #f

; (i-lookup state symbol mach)

; returns #f if no instruction of Turing machine mach has state and
; symbol equal to state and symbol; otherwise, returns the instruction
; in mach that matches.  You may assume that at most one instruction
; will match.

; The latter point is based on the requirement that Turing machines be
; deterministic, that is, there is only one way to execute a given
; program for a given input.

; For this assignment, when writing Turing machine programs (problems
; 1, 7, and 8) be certain that no two instructions have the same
; c-symbol and c-state (with differing n-state, n-symbol, or dir).

; Examples
; (i-match? 'q1 'b (ins 'q1 'b 'q3 'b 'L)) => #t
; (i-match? 'q1  0  (ins 'q1 1 'q4 1 'L)) => #f
; (i-match? 'q2 1 (ins 'q2 1 'q2 1 'L)) => #t
; (equal? (i-lookup 'q1 1 tm1) (ins 'q1 1 'q1 0 'R)) => #t
; (equal? (i-lookup 'q2 'b tm1) (ins 'q2 'b 'q3 'b 'R)) => #t
; (i-lookup 'q3 1 tm1) => #f
; ****************************************************************

; i-match? : symbol symbol-or-number ins -> boolean
(define i-match? empty)

; i-lookup : symbol symbol-or-number (listof ins) -> ins-or-false
(define i-lookup empty)

; ****************************************************************
; Representation of a Turing machine configuration.
; We represent a Turing machine configuration using the following structure:

(struct conf (state ltape symbol rtape) #:transparent)

; where state is the current state of the machine,
; ltape is a list of symbols to the left of the currently scanned symbol,
; symbol is the currently scanned symbol,
; rtape is a list of symbols to the right of the currently scanned symbol.

; We reserve the symbol 'b for the blank.

; For example, we define the following two configurations:

(define config1 (conf 'q3 '(0 0) 1 '(1)))
(define config2 (conf 'q6 '(1 b) 0 '(b b)))

; Note that the selectors are
; conf-state, conf-ltape, conf-symbol, conf-rtape

; config1 represents the Turing machine configuration

;   --------------------------
;   .. | 0 | 0 | 1 | 1 |  | ..
;   --------------------------
;                ^
;                q3

; in which the non-blank symbols on the tape are 0011,
; and the machine is in state q3 with the read/write head
; scanning the leftmost 1.

; config2 represents the Turing machine configuration

;   ------------------------------
;   .. |   | 1 |  | 0 |   |   | ..
;   ------------------------------
;                   ^
;                   q6

; in which the symbols 1, blank, 0, are on the tape, surrounded
; by blanks, and the machine is in state q6 with the read/write
; head scanning the 0.

; A configuration is *normalized* if neither the first symbol of
; ltape nor the last symbol of rtape is the symbol 'b.
; Of the two configurations above, config1 is normalized, 
; but config2 is not (the last element of its rtape list is 'b.)

; Note that tape squares not explicitly represented are
; assumed to contain blanks.  A normalized configuration
; to represent the machine in state q1 with all tape squares
; blank is thus (conf 'q1 '() 'b '())).

; ****************************************************************
; ** problem 2 (9 points)
; Write the following three procedures.

; (halted? mach config)
; returns #t if the Turing machine mach is halted in machine configuration config 
; (ie, no instruction of the machine matches the current state and symbol 
; in configuration config) and returns #f otherwise.

; (change-state new-state config)
; takes a configuration config and returns a configuration
; in which the state of the machine is changed to new-state.

; (write-symbol new-symbol config) takes a configuration config and
; returns a configuration in which the symbol scanned by 
; the read/write head has been replaced by new-symbol.

; Examples
; (halted? tm1 (conf 'q1 '(1 1 0) 'b '())) => #f
; (halted? (list (ins 'q1 'b 'q2 'b 'R)) (conf 'q2 '() 'b '())) => #t
; (change-state 'q2 (conf 'q1 '(0) 1 '())) => (conf 'q2 '(0) 1 '())
; (change-state 'q13 (conf 'q4 '(0 1 1) 'b '())) => (conf 'q13 '(0 1 1) 'b '())
; (write-symbol 1 (conf 'q5 '(0) 0 '(1 1))) => (conf 'q5 '(0) 1 '(1 1))
; (write-symbol 'c (conf 'q2 '(0 0 1) 1 '(1 1))) => (conf 'q2 '(0 0 1) 'c '(1 1))
; (write-symbol 'b (conf 'q3 '(1) 0 '())) => (conf 'q3 '(1) 'b '())
; ****************************************************************

; halted? : (listof ins) conf -> boolean
(define halted? empty)

; change-state : symbol conf -> conf
(define change-state empty)

; write-symbol : symbol-or-number conf -> conf
(define write-symbol empty)

; ****************************************************************
; ** problem 3 ** (10 points)
; Write one procedure

; (normalize config)
; takes a Turing machine configuration config and returns an equivalent 
; *normalized* configuration. That is, the same Turing machine configuration is
; represented by the input configuration and the output configuration, 
; and the output configuration does not have a 'b as the first element 
; of its ltape list or the last element of its rtape list.

; Examples
; (normalize config1) => (conf 'q3 '(0 0) 1 '(1))
; (normalize config2) => (conf 'q6 '(1 b) 0 '())
; (normalize (conf 'q3 '(b 0) 'b '(1 1 0 b b))) => (conf 'q3 '(0) 'b '(1 1 0))
; (normalize (conf 'q6 '(b 0 b 0) 1 '(0 b 0 b))) => (conf 'q6 '(0 b 0) 1 '(0 b 0))
; (normalize (conf 'q4 '(b b) 'b '(b b b))) => (conf 'q4 '() 'b '())
; ****************************************************************

; normalize : conf -> conf
(define normalize empty)

; ****************************************************************
; ** problem 4 ** (10 points)
; Write two procedures

; (shift-head-left config)
; takes a normalized configuration config and returns a normalized configuration 
; in which the position of the read/write head has been moved one tape square 
; to the left.

; (shift-head-right config)
; takes a normalized configuration config and returns a normalized configuration 
; in which the position of the read/write head has been moved one tape square 
; to the right.

; Examples
; (shift-head-left (conf 'q5 '() 'b '())) => (conf 'q5 '() 'b '())
; (shift-head-left (conf 'q6 '(0 0) 1 '(1 1))) => (conf 'q6 '(0) 0 '(1 1 1))
; (shift-head-left (conf 'q7 '() 0 '(1 1 0))) => (conf 'q7 '() 'b '(0 1 1 0))
; (shift-head-right (conf 'q2 '() 'b '())) => (conf 'q2 '() 'b '())
; (shift-head-right (conf 'q9 '() 0 '(1 1 1))) => (conf 'q9 '(0) 1 '(1 1))
; (shift-head-right (conf 'q8 '(1 0 1 1) 'b '())) => (conf 'q8 '(1 0 1 1 b) 'b '())
; ****************************************************************


; shift-head-left : conf -> conf
(define shift-head-left empty)

; shift-head-right : conf -> conf
(define shift-head-right empty)

; ****************************************************************
; ** problem 5 ** (15 points)
; Write a procedure 

; (next-config mach config)
; takes a Turing machine mach and a normalized configuration config
; and returns the normalized next configuration 
; for the Turing machine mach in the configuration config.
; If there is no applicable instruction, the configuration
; returned should be just the input configuration.

; Hint: get your procedures halted?, i-lookup, change-state,
; write-symbol, shift-head-left, shift-head-right working and combine
; them appropriately.

; Examples
; (next-config tm1 (conf 'q1 '() 0 '(0 1))) => (conf 'q1 '(1) 0 '(1))
; (next-config tm1 (conf 'q1 '(1) 0 '(1))) => (conf 'q1 '(1 1) 1 '())
; (next-config tm1 (conf 'q1 '(1 1 0) 'b '())) => (conf 'q2 '(1 1) 0 '())
; (next-config tm1 (conf 'q2 '() 'b '(1 1 0))) => (conf 'q3 '() 1 '(1 0))
; (next-config tm1 (conf 'q3 '() 1 '(1 0))) => (conf 'q3 '() 1 '(1 0))
; ****************************************************************

; next-config : (listof ins) conf -> conf
(define next-config empty)

; ****************************************************************
; If your procedures are working, then you should
; be able to run the following example, which
; shows the successive normalized configurations 
; of Turing machine tm1 when run from the given configuration.

;> (simulate tm1 (conf 'q1 '() 1 '(1 0 1 0)) 20)
;(list
; (conf 'q1 '() 1 '(1 0 1 0))
; (conf 'q1 '(0) 1 '(0 1 0))
; (conf 'q1 '(0 0) 0 '(1 0))
; (conf 'q1 '(0 0 1) 1 '(0))
; (conf 'q1 '(0 0 1 0) 0 '())
; (conf 'q1 '(0 0 1 0 1) 'b '())
; (conf 'q2 '(0 0 1 0) 1 '())
; (conf 'q2 '(0 0 1) 0 '(1))
; (conf 'q2 '(0 0) 1 '(0 1))
; (conf 'q2 '(0) 0 '(1 0 1))
; (conf 'q2 '() 0 '(0 1 0 1))
; (conf 'q2 '() 'b '(0 0 1 0 1))
; (conf 'q3 '() 0 '(0 1 0 1)))



; ****************************************************************
; ** problem 6 (15 points)
; Define (in the format just given) a Turing machine named

; tm-reverse

; that takes an input string of 0's and 1's and produces an output
; string equal to the reverse of the input string.  When the machine
; halts, the head should be scanning the leftmost symbol of the
; output.

; That is, when started in state q1 with the head on the leftmost of a
; string of 0's and 1's, it halts with the head on the leftmost of a
; string of 0's and 1's, and the output string is obtained from the
; input string by reversing it.

; Your machine *may* use additional tape symbols but the output should
; contain no symbols other than 0, 1 and blank.  When the machine
; halts, symbols other than the output should be blank.

; Examples of the behavior of tm-reverse
; 1            =>  1
; 110          =>  011
; 0001         =>  1000
; 101011       =>  110101

; Examples you can run after you implement :
;
; (simulate-lite tm-reverse (conf 'q1 '() 1 '()) 20) => '(() 1 ())
; (simulate-lite tm-reverse (conf 'q1 '() 1 '(1 0)) 200) => '(() 0 (1 1))
; (simulate-lite tm-reverse (conf 'q1 '() 0 '(0 0 1)) 200) => '(() 1 (0 0 0))
; (simulate-lite tm-reverse (conf 'q1 '() 1 '(0 1 0 1 1)) 200) => '(() 1 (1 0 1 0 1))

; The initial state of your machine should be q1 -- other states may
; be named with Racket symbols of your choice.

; IMPORTANT: please describe how your Turing machine works. 

; ****************************************************************
(define tm-reverse
  (list
   ;; your instructions here
  ))

; ****************************************************************
; ** problem 7 ** (15 points)
; Define (in the given representation) a Turing machine named

; tm-parity

; that takes as input a positive integer n represented in binary and
; produces as output a 1 if the number has an odd number of 1's, else
; 0.  When the machine halts, the read/write head should be positioned
; over the leftmost b to the right of the 0 or 1 you output.
; The start state should be named q1 -- other states may be
; named by any other Racket symbols.

; You *may* use additional tape symbols.  When the machine halts,
; there should be just a single binary digit, 0 or 1, surrounded by
; blanks, on the tape.

; IMPORTANT: Give a clear overview description of how your Turing machine works.

; NOTE: you can still do this problem if your simulator is not working, 
; assuming you understand Turing machines and the representation of them 
; defined above.

; A parity bit is often used for error checking in data transmission.
; See https://en.wikipedia.org/wiki/Parity_bit 

; Examples of the behavior of tm-parity
; 1            => 1
; 11           => 0
; 110          => 0
; 1111         => 0
; 1110110      => 1

; (simulate-lite tm-parity (conf 'q1 '() 1 '()) 20) => '((1) b ())
; (simulate-lite tm-parity (conf 'q1 '() 1 '(1)) 200) => '((0) b ())
; (simulate-lite tm-parity (conf 'q1 '() 1 '(1 0)) 200) => '((0) b ())
; (simulate-lite tm-parity (conf 'q1 '() 1 '(1 1 1)) 400) => '((0) b ())
; (simulate-lite tm-parity (conf 'q1 '() 1 '(1 1 0 1 1 0)) 400) => '((1) b ())

; ****************************************************************

(define tm-parity
  (list
      ;; Your instructions here
  ))

; ****************************************************************
; ** problem 8 ** (15 points)
; Define (in the given representation) a Turing machine named

; tm-sort

; that takes as input a non-empty string of 0's and 1's
; and produces as output a string of 0's and 1's equal to the input
; string rearranged to have all the 0's before all the 1's.
; When the machine halts, the read/write head should be positioned over the
; leftmost 0 or 1 in the output string.  The start state should be named
; q1 -- other states may be named by any other Racket symbols.

; You *may* use additional tape symbols.  When the machine halts,
; the only non-blank symbols on the tape should be the output string.

; IMPORTANT: Give a clear overview description of how your Turing machine works.

; NOTE: you can still do this problem if your simulator is not working, 
; assuming you understand Turing machines and the representation of them 
; defined above.

; Examples of the behavior of tm-sort
; 0          => 0  
; 1          => 1
; 00         => 00
; 110        => 011
; 1011011    => 0011111

; (simulate-lite tm-sort (conf 'q1 '() 0 '()) 20)   => '(() 0 ())
; (simulate-lite tm-sort (conf 'q1 '() 1 '()) 20)   => '(() 1 ())
; (simulate-lite tm-sort (conf 'q1 '() 0 '(0)) 200) => '(() 0 (0))
; (simulate-lite tm-sort (conf 'q1 '() 1 '(1 0)) 200) => '(() 0 (1 1))
; (simulate-lite tm-sort (conf 'q1 '() 1 '(0 1 1 0 1 1)) 200) => '(() 0 (0 1 1 1 1 1))


; Here are some input configurations if you want to simulate your tm-sort on
; these inputs.

(define sort0 (conf 'q1 '() 0 '()))
(define sort1 (conf 'q1 '() 1 '()))
(define sort00 (conf 'q1 '() 0 '(0)))
(define sort110 (conf 'q1 '() 1 '(1 0)))
(define sort-long (conf 'q1 '() 1 '(0 1 1 0 1 1)))
; ****************************************************************

(define tm-sort
  (list
   ;; your instructions here 
   ))


; ****************************************************************
; ********  testing, testing. 1, 2, 3 ....
; ****************************************************************

; Press Run in DrRacket, and then type (runtests) in the
; Interactions area to run automated tests on your code.

(define (format-expected-actual expected actual)
  (format "Correct answer should be ~a. Your answer was: ~a." expected actual))

(define (approx=? a b [eps 1e-9])
  (and (real? a)
       (real? b)
       (<= (abs (- (exact->inexact a) (exact->inexact b))) eps)))

(struct test-result (name ok? got expected output) #:transparent)

(define (test name got-thunk expected [expected-text #f])
  (define expected-display
    (cond
      [expected-text expected-text]
      [(procedure? expected) "a value satisfying the expected predicate"]
      [else expected]))
  (with-handlers ([exn:fail?
                   (lambda (e)
                     (test-result name
                                  #f
                                  (list 'error (exn-message e))
                                  expected-display
                                  (format "Error while running: ~a" (exn-message e))))])
    (define got (got-thunk))
    (define ok?
      (if (procedure? expected)
          (with-handlers ([exn:fail? (lambda (_e) #f)])
            (expected got))
          (equal? got expected)))
    (test-result name ok? got expected-display
                 (format-expected-actual expected-display got))))

(define (print-test-result r)
  (define status (if (test-result-ok? r) "OK" "FAIL"))
  (printf "[~a] ~a\n" status (test-result-name r))
  (when (not (test-result-ok? r))
    (printf "  expected: ~a\n" (test-result-expected r))
    (printf "  got:      ~a\n" (test-result-got r))
    (printf "  ~a\n" (test-result-output r))))

; Helpers for extra "property-style" tests (Problems 6-8).

; all-bitlists-of-length : number -> (listof (listof number))
; Returns all lists of 0s and 1s of length n.
(define (all-bitlists-of-length n)
  (cond
    [(= n 0) (list '())]
    [else
     (append
      (map (lambda (xs) (cons 0 xs)) (all-bitlists-of-length (- n 1)))
      (map (lambda (xs) (cons 1 xs)) (all-bitlists-of-length (- n 1))))]))

; all-bitlists-1-to : number -> (listof (listof number))
; Returns all non-empty lists of 0s and 1s of lengths 1..max-len.
(define (all-bitlists-1-to max-len)
  (apply append (map all-bitlists-of-length (range 1 (+ max-len 1)))))

; bits->config : (nonempty (listof number)) -> conf
(define (bits->config bits)
  (conf 'q1 '() (car bits) (cdr bits)))

; expected-head-leftmost : (nonempty (listof any)) -> (list ltape symbol rtape)
(define (expected-head-leftmost syms)
  (list '() (car syms) (cdr syms)))

; parity-bit : (nonempty (listof number)) -> number
(define (parity-bit bits)
  (if (odd? (length (filter (lambda (b) (= b 1)) bits))) 1 0))

; sorted-bits : (nonempty (listof number)) -> (nonempty (listof number))
(define (sorted-bits bits)
  (define ones (length (filter (lambda (b) (= b 1)) bits)))
  (define zeros (- (length bits) ones))
  (append (make-list zeros 0) (make-list ones 1)))

(define (reverse-ok? bits steps)
  (define got (simulate-lite tm-reverse (bits->config bits) steps))
  (and (not (equal? got 'timeout))
       (equal? got (expected-head-leftmost (reverse bits)))))

(define (parity-ok? bits steps)
  (define got (simulate-lite tm-parity (bits->config bits) steps))
  (and (not (equal? got 'timeout))
       (equal? got (list (list (parity-bit bits)) 'b '()))))

(define (sort-ok? bits steps)
  (define got (simulate-lite tm-sort (bits->config bits) steps))
  (and (not (equal? got 'timeout))
       (equal? got (expected-head-leftmost (sorted-bits bits)))))

(define (runtests)
  (define results
    (list
     (test 'hours (lambda () hours) (lambda (x) (and (number? x) (> x 0))) "a positive number")

     ;; problem 1: i-match? and i-lookup
     (test 'i-match?-example-1
           (lambda () (i-match? 'q1 'b (ins 'q1 'b 'q3 'b 'L)))
           #t)
     (test 'i-match?-example-2
           (lambda () (i-match? 'q1 0 (ins 'q1 1 'q4 1 'L)))
           #f)
     (test 'i-match?-example-3
           (lambda () (i-match? 'q2 1 (ins 'q2 1 'q2 1 'L)))
           #t)
     (test 'i-lookup-example-1
           (lambda () (equal? (i-lookup 'q1 1 tm1) (ins 'q1 1 'q1 0 'R)))
           #t)
     (test 'i-lookup-example-2
           (lambda () (equal? (i-lookup 'q2 'b tm1) (ins 'q2 'b 'q3 'b 'R)))
           #t)
     (test 'i-lookup-example-3
           (lambda () (i-lookup 'q3 1 tm1))
           #f)

     ;; problem 2: halted?, change-state, write-symbol
     (test 'halted?-example-1
           (lambda () (halted? tm1 (conf 'q1 '(1 1 0) 'b '())))
           #f)
     (test 'halted?-example-2
           (lambda () (halted? (list (ins 'q1 'b 'q2 'b 'R)) (conf 'q2 '() 'b '())))
           #t)
     (test 'change-state-example-1
           (lambda () (change-state 'q2 (conf 'q1 '(0) 1 '())))
           (conf 'q2 '(0) 1 '()))
     (test 'change-state-example-2
           (lambda () (change-state 'q13 (conf 'q4 '(0 1 1) 'b '())))
           (conf 'q13 '(0 1 1) 'b '()))
     (test 'write-symbol-example-1
           (lambda () (write-symbol 1 (conf 'q5 '(0) 0 '(1 1))))
           (conf 'q5 '(0) 1 '(1 1)))
     (test 'write-symbol-example-2
           (lambda () (write-symbol 'c (conf 'q2 '(0 0 1) 1 '(1 1))))
           (conf 'q2 '(0 0 1) 'c '(1 1)))
     (test 'write-symbol-example-3
           (lambda () (write-symbol 'b (conf 'q3 '(1) 0 '())))
           (conf 'q3 '(1) 'b '()))

     ;; problem 3: normalize
     (test 'normalize-example-1
           (lambda () (normalize config1))
           (conf 'q3 '(0 0) 1 '(1)))
     (test 'normalize-example-2
           (lambda () (normalize config2))
           (conf 'q6 '(1 b) 0 '()))
     (test 'normalize-example-3
           (lambda () (normalize (conf 'q3 '(b 0) 'b '(1 1 0 b b))))
           (conf 'q3 '(0) 'b '(1 1 0)))
     (test 'normalize-example-4
           (lambda () (normalize (conf 'q6 '(b 0 b 0) 1 '(0 b 0 b))))
           (conf 'q6 '(0 b 0) 1 '(0 b 0)))
     (test 'normalize-example-5
           (lambda () (normalize (conf 'q4 '(b b) 'b '(b b b))))
           (conf 'q4 '() 'b '()))

     ;; problem 4: shift-head-left and shift-head-right
     (test 'shift-head-left-example-1
           (lambda () (shift-head-left (conf 'q5 '() 'b '())))
           (conf 'q5 '() 'b '()))
     (test 'shift-head-left-example-2
           (lambda () (shift-head-left (conf 'q6 '(0 0) 1 '(1 1))))
           (conf 'q6 '(0) 0 '(1 1 1)))
     (test 'shift-head-left-example-3
           (lambda () (shift-head-left (conf 'q7 '() 0 '(1 1 0))))
           (conf 'q7 '() 'b '(0 1 1 0)))
     (test 'shift-head-right-example-1
           (lambda () (shift-head-right (conf 'q2 '() 'b '())))
           (conf 'q2 '() 'b '()))
     (test 'shift-head-right-example-2
           (lambda () (shift-head-right (conf 'q9 '() 0 '(1 1 1))))
           (conf 'q9 '(0) 1 '(1 1)))
     (test 'shift-head-right-example-3
           (lambda () (shift-head-right (conf 'q8 '(1 0 1 1) 'b '())))
           (conf 'q8 '(1 0 1 1 b) 'b '()))

     ;; problem 5: next-config (+ simulate example)
     (test 'next-config-example-1
           (lambda () (next-config tm1 (conf 'q1 '() 0 '(0 1))))
           (conf 'q1 '(1) 0 '(1)))
     (test 'next-config-example-2
           (lambda () (next-config tm1 (conf 'q1 '(1) 0 '(1))))
           (conf 'q1 '(1 1) 1 '()))
     (test 'next-config-example-3
           (lambda () (next-config tm1 (conf 'q1 '(1 1 0) 'b '())))
           (conf 'q2 '(1 1) 0 '()))
     (test 'next-config-example-4
           (lambda () (next-config tm1 (conf 'q2 '() 'b '(1 1 0))))
           (conf 'q3 '() 1 '(1 0)))
     (test 'next-config-example-5
           (lambda () (next-config tm1 (conf 'q3 '() 1 '(1 0))))
           (conf 'q3 '() 1 '(1 0)))
     (test 'simulate-tm1-example
           (lambda () (simulate tm1 (conf 'q1 '() 1 '(1 0 1 0)) 20))
           (list
            (conf 'q1 '() 1 '(1 0 1 0))
            (conf 'q1 '(0) 1 '(0 1 0))
            (conf 'q1 '(0 0) 0 '(1 0))
            (conf 'q1 '(0 0 1) 1 '(0))
            (conf 'q1 '(0 0 1 0) 0 '())
            (conf 'q1 '(0 0 1 0 1) 'b '())
            (conf 'q2 '(0 0 1 0) 1 '())
            (conf 'q2 '(0 0 1) 0 '(1))
            (conf 'q2 '(0 0) 1 '(0 1))
            (conf 'q2 '(0) 0 '(1 0 1))
            (conf 'q2 '() 0 '(0 1 0 1))
            (conf 'q2 '() 'b '(0 0 1 0 1))
            (conf 'q3 '() 0 '(0 1 0 1))))

     ;; problem 6: tm-reverse (simulate-lite examples)
     (test 'tm-reverse-example-1
           (lambda () (simulate-lite tm-reverse (conf 'q1 '() 1 '()) 20))
           '(() 1 ()))
     (test 'tm-reverse-example-2
           (lambda () (simulate-lite tm-reverse (conf 'q1 '() 1 '(1 0)) 200))
           '(() 0 (1 1)))
     (test 'tm-reverse-example-3
           (lambda () (simulate-lite tm-reverse (conf 'q1 '() 0 '(0 0 1)) 200))
           '(() 1 (0 0 0)))
     (test 'tm-reverse-example-4
           (lambda () (simulate-lite tm-reverse (conf 'q1 '() 1 '(0 1 0 1 1)) 200))
           '(() 1 (1 0 1 0 1)))

     ;; problem 7: tm-parity (simulate-lite examples)
     (test 'tm-parity-example-1
           (lambda () (simulate-lite tm-parity (conf 'q1 '() 1 '()) 20))
           '((1) b ()))
     (test 'tm-parity-example-2
           (lambda () (simulate-lite tm-parity (conf 'q1 '() 1 '(1)) 200))
           '((0) b ()))
     (test 'tm-parity-example-3
           (lambda () (simulate-lite tm-parity (conf 'q1 '() 1 '(1 0)) 200))
           '((0) b ()))
     (test 'tm-parity-example-4
           (lambda () (simulate-lite tm-parity (conf 'q1 '() 1 '(1 1 1)) 400))
           '((0) b ()))
     (test 'tm-parity-example-5
           (lambda () (simulate-lite tm-parity (conf 'q1 '() 1 '(1 1 0 1 1 0)) 400))
           '((1) b ()))

     ;; problem 8: tm-sort (simulate-lite examples)
     (test 'tm-sort-example-1
           (lambda () (simulate-lite tm-sort (conf 'q1 '() 0 '()) 20))
           '(() 0 ()))
     (test 'tm-sort-example-2
           (lambda () (simulate-lite tm-sort (conf 'q1 '() 1 '()) 20))
           '(() 1 ()))
     (test 'tm-sort-example-3
           (lambda () (simulate-lite tm-sort (conf 'q1 '() 0 '(0)) 200))
           '(() 0 (0)))
     (test 'tm-sort-example-4
           (lambda () (simulate-lite tm-sort (conf 'q1 '() 1 '(1 0)) 200))
           '(() 0 (1 1)))
     (test 'tm-sort-example-5
           (lambda () (simulate-lite tm-sort (conf 'q1 '() 1 '(0 1 1 0 1 1)) 200))
           '(() 0 (0 1 1 1 1 1)))

     ;; extra edge-case tests
     (test 'tm-reverse-all-bitstrings-len<=6
           (lambda ()
             (define steps 800)
             (andmap (lambda (bits) (reverse-ok? bits steps)) (all-bitlists-1-to 6)))
           #t
           "tm-reverse should reverse all 0/1 strings (len<=6)")
     (test 'tm-parity-all-bitstrings-len<=6
           (lambda ()
             (define steps 800)
             (andmap (lambda (bits) (parity-ok? bits steps)) (all-bitlists-1-to 6)))
           #t
           "tm-parity should output correct parity bit (len<=6)")
     (test 'tm-sort-all-bitstrings-len<=6
           (lambda ()
             (define steps 800)
             (andmap (lambda (bits) (sort-ok? bits steps)) (all-bitlists-1-to 6)))
           #t
           "tm-sort should sort all 0/1 strings (len<=6)")))

  (displayln "Running tests...")
  (for-each print-test-result results)
  (define passed (length (filter test-result-ok? results)))
  (printf "\nPassed ~a / ~a tests.\n" passed (length results)))


; *************** end of hw3.rkt *********************************