; (require "srfi-1")
;
(use debug)
(use numbers) 
(use srfi-19)
(declare (uses shuffle))
(define debug? (make-parameter #t))

(define auxilliary 0)
(define basic 8)
(define basic/auxilliary (+ basic auxilliary))
(define compound 8)
(define isolated 1)

(define (auxilliary-compound)
  (* auxilliary compound))

(define (auxilliary-isolated)
  (* auxilliary isolated))

(define (basic-compound)
  (* basic compound))

(define (basic-isolated)
  (* basic isolated))

(define (basic/auxilliary-isolated)
  (* basic/auxilliary isolated))

(define (basic/auxilliary-compound)
  (* basic/auxilliary compound))

(define abdominal (append
		     (make-list (basic-compound) "Push Sit-Up")))
(define back (append
	        (make-list (basic-compound) "Bent-over Row")
		(make-list (basic-compound) "Lying Row")))
(define biceps (append
		  (make-list (basic-isolated) "Curl")
		  (make-list (basic/auxilliary-isolated) "Inclined Curl")))
(define calves (append
		  (make-list (basic-isolated) "Standing Calf Raise")
		  (make-list (basic/auxilliary-isolated) "Single Leg Calf Raise")))
(define cardio (list "cardio"))
(define chest (append
	         (make-list (basic-compound) "Bench Press")
       		 (make-list (basic/auxilliary-compound) "Decline Bench Press")
		 (make-list (auxilliary-isolated) "Decline Fly")
		 (make-list (auxilliary-isolated) "Fly")
		 (make-list (auxilliary-isolated) "Pullover")
		 (make-list (auxilliary-isolated) "Pullover On Apparatus")
		 (make-list (auxilliary-isolated) "Pullover On Arched Bench")))
(define deltoid-front (append
		         (make-list (basic/auxilliary-compound) "Arnold Press")
		         (make-list (auxilliary-isolated) "Front Raise")
		         (make-list (auxilliary-isolated) "Alternating Front Raise")
		         (make-list (auxilliary-isolated) "Alternating Incline Front Raise")
		         (make-list (basic-compound) "Shoulder Press")
		         (make-list (basic/auxilliary-compound) "One Arm Shoulder Press")))
(define deltoid-side (append
		        (make-list (auxilliary-isolated) "Incline Lateral Raise")
			(make-list (basic/auxilliary-isolated) "Lateral Raise")
			(make-list (auxilliary-isolated) "One Arm Lateral Raise")
			(make-list (auxilliary-isolated) "Lying Lateral Raise")
			(make-list (basic-compound) "Raise")
			(make-list (basic-compound) "Upright Row")
			(make-list (basic/auxilliary-compound) "One Arm Upright Row")))
(define hamstrings (append
		      (make-list (basic-compound) "Straight-Leg Deadlift")
		      (make-list (basic/auxilliary-isolated) "Straight-Back")))
(define low-back (append
;		    (make-list () "Dumbbell Stiff Leg Deadlift")
		    (make-list (basic/auxilliary-compound) "One Arm Stiff Leg Deadlift")
;		    (make-list () "Dumbbell Deadlift")
;		    (make-list () "Good Mornings")
;		    (make-list () "Dumbbell Squats")
		    (make-list (basic/auxilliary-compound) "Dumbbell Hyperextensions")))
(define meditate (list "meditate"))
(define quadriceps (append
		      (make-list (auxilliary-compound) "Lunge")
		      (make-list (auxilliary-compound) "Rear Lunge")
		      (make-list (auxilliary-compound) "Side Lunge")
		      (make-list (auxilliary-compound) "Walking Lunge")
		      (make-list (auxilliary-compound) "Single Leg Split Squat")
		      (make-list (auxilliary-compound) "Single Leg Squat")
		      (make-list (auxilliary-compound) "Split Squat")
		      (make-list (basic/auxilliary-compound) "Squat")
		      (make-list (basic/auxilliary-compound) "Front Squat")
		      (make-list (basic/auxilliary-compound) "Step-Up")
		      (make-list (auxilliary-compound) "Lateral")
		      (make-list (auxilliary-compound) "Step Down")))
(define triceps (append
		   (make-list (auxilliary-isolated) "Kickback")
		   (make-list (basic/auxilliary-isolated) "Lying triceps extension")
		   (make-list (auxilliary-isolated) "Decline triceps extension")
		   (make-list (auxilliary-isolated) "Incline triceps extension")
		   (make-list (basic/auxilliary-isolated) "One arm triceps extension")
		   (make-list (basic/auxilliary-isolated) "One arm triceps extension on bench")
		   (make-list (basic/auxilliary-isolated) "Triceps extension")))
(define alternating-push/pull-#1 (list
				  meditate
				  cardio
				  quadriceps
				  hamstrings
				  chest
				  deltoid-side
				  calves
				  back
				  triceps
				  biceps
				  abdominal
				  low-back))
(define alternating-push/pull-#2 (list
				  meditate
				  cardio
				  quadriceps
				  hamstrings
				  chest
				  back
				  deltoid-front
				  biceps
				  triceps
				  abdominal
				  calves
				  low-back))
(define alternating-push/pull-#3 (list
				  meditate
				  cardio
				  back
				  chest
				  deltoid-side
				  quadriceps
				  hamstrings
				  calves
				  biceps
				  triceps
				  abdominal
				  low-back))
(define alternating-push/pull-#4 (list
				  meditate
				  cardio
				  chest
				  back
				  deltoid-front
				  quadriceps
				  hamstrings
				  calves
				  biceps
				  triceps
				  abdominal
				  low-back))
(define alternating-upper/lower-#1 (list
				    meditate
				    cardio
				    back
				    quadriceps
				    chest
				    hamstrings
				    deltoid-front
				    calves
				    biceps
				    abdominal
				    triceps
				    low-back))
(define alternating-upper/lower-#2 (list
				    meditate
				    cardio
				    chest
				    hamstrings
				    back
				    quadriceps
				    deltoid-side
				    calves
				    biceps
				    abdominal
				    triceps
				    low-back))
(define legs-pull-push-#1 (list
			   meditate
			   cardio
			   quadriceps
			   hamstrings
			   calves
			   back
			   deltoid-side
			   biceps
			   chest
			   deltoid-front
			   triceps
			   abdominal
			   low-back))
(define legs-pull-push-#2 (list
			   meditate
			   cardio
			   quadriceps
			   hamstrings
			   calves
			   chest
			   deltoid-front
			   triceps
			   back
			   deltoid-side
			   biceps
			   abdominal
			   low-back))
(define legs-pull-push-#3 (list
			   meditate
			   cardio
			   back
			   deltoid-side
			   biceps
			   chest
			   deltoid-front
			   triceps
			   quadriceps
			   hamstrings
			   calves
			   abdominal
			   low-back))
(define legs-pull-push-#4 (list
			   meditate
			   cardio
			   chest
			   deltoid-front
			   triceps
			   back
			   deltoid-side
			   biceps
			   quadriceps
			   hamstrings
			   calves
			   abdominal
			   low-back))
(define legs-torso-arms-#1 (list
			    meditate
			    cardio
			    quadriceps
			    hamstrings
			    calves
			    back
			    deltoid-side
			    chest
			    deltoid-front
			    biceps
			    triceps
			    abdominal
			    low-back))
(define legs-torso-arms-#2 (list
			    meditate
			    cardio
			    quadriceps
			    hamstrings
			    calves
			    chest
			    deltoid-front
			    back
			    deltoid-side
			    triceps
			    biceps
			    abdominal
			    low-back))
(define legs-torso-arms-#3 (list
			    meditate
			    cardio
			    back
			    deltoid-side
			    chest
			    deltoid-front
			    biceps
			    triceps
			    quadriceps
			    hamstrings
			    calves
			    abdominal
			    low-back))
(define legs-torso-arms-#4 (list
			    meditate
			    cardio
			    chest
			    deltoid-front
			    back
			    deltoid-side
			    triceps
			    biceps
			    quadriceps
			    hamstrings
			    calves
			    abdominal
			    low-back))
(define random-workout (list
			abdominal
			back
			biceps
			calves
			chest
			deltoid-front
			deltoid-side
			hamstrings
			low-back
			quadriceps
			triceps))
(define randomized (list "randomized"))

(define torso-twists (list "12 torso twists on each side"))

(define boat-rows (list "20 boat rows on each side"))

(define soviet-sickles (list "10 soviet sickles on each side"))

(define Bull-roarers (list "20 Bull roarers on each side"))

(define Grutte-Piers (list "20 Grutte Piers on each side"))

(define Stakhanov-shovels (list "12 Stakhanov shovels on each side"))

(define John-Henrys (list "12 John Henrys on each side"))

(define sickle-swings (list "12 sickle swings on each side"))

(define soup-stirs (list "12 soup stirs on each side"))

(define extra-Bull-roarers (list "20 extra Bull roarers on each side"))

(define extra-Grutte-Piers (list "20 extra Grutte Piers on each side"))

(define forward-tree-chops (list "20 forward tree chops on each side"))

(define flat-back-minings (list "12 flat back minings on each side"))

(define cavern-chips (list "20 cavern chips on each side"))

(define iron-roundhouses (list "10 iron roundhouses on each side"))

(define namastes (list "20 namastes on each side"))

(define skyhooks (list "10 skyhooks on each side"))

(define pick-ups (list "20 pick-ups on each side"))

(define spear-thrusts (list "10 spear thrusts on each side"))

(define high-hammers (list "20 high hammers on each side"))

(define more-torso-twists (list "12 more torso twists on each side"))

(define more-boat-rows (list "20 more boat rows on each side"))

(define more-soviet-sickles (list "10 more soviet sickles on each side"))

(define shovelgloving (list
		       meditate
		       cardio
		       torso-twists
		       boat-rows
		       soviet-sickles
		       Bull-roarers
		       Grutte-Piers
		       Stakhanov-shovels
		       John-Henrys
		       sickle-swings
		       soup-stirs
		       extra-Bull-roarers
		       extra-Grutte-Piers
		       forward-tree-chops
		       flat-back-minings
		       cavern-chips
		       iron-roundhouses
		       namastes
		       skyhooks
		       pick-ups
		       spear-thrusts
		       high-hammers
		       more-torso-twists
		       more-boat-rows
		       more-soviet-sickles))

(define all-the-templates (list
			   legs-torso-arms-#1
			   legs-torso-arms-#2
			   legs-torso-arms-#3
			   legs-torso-arms-#4
			   legs-pull-push-#1
			   legs-pull-push-#2
			   legs-pull-push-#3
			   legs-pull-push-#4
			   alternating-push/pull-#1
			   alternating-push/pull-#2
			   alternating-push/pull-#3
			   alternating-push/pull-#4
			   alternating-upper/lower-#1
			   alternating-upper/lower-#2
			   randomized
			   shovelgloving))

(define (calculate-day-count prando-date)
  (let* ((days-since-previous-system-ended (- prando-date 7999))
	 (8-out-of-64-excluded (exclude 8 64 days-since-previous-system-ended)))
    (exclude 1 8 8-out-of-64-excluded)))

(define (cardiovascular number)
  (let* ((increase (/ number 10.0))
	 (speed (+ 5.7 increase))
	 (speed (min speed 12))
	 (speed-string (number->string speed)))
    (string-append "Run for 30 minutes at " speed-string " m.p.h.")))

(define (calculate-exclusions out-of-every from)
  (let* ((the-quotient (whole-/ from out-of-every))
	  (number-of-exclusions (+ the-quotient 1)))
    (if (= (remainder from out-of-every) 0)
	(- number-of-exclusions 1)
	number-of-exclusions)))

(define (choose-exercise-for-each the-groups the-round)
  (if (null? the-groups)
      '()
      (let* ((the-1-group (car the-groups))
	     (the-1-exercise (choose-the-exercise the-1-group the-round))
	     (the-remaining-groups (cdr the-groups))
	     (the-remaining-exercises (choose-exercise-for-each the-remaining-groups the-round)))
	(append the-1-exercise the-remaining-exercises))))

(define (choose-exercises-from-groups the-groups the-count)
  (let * ((the-round (whole-/ the-count number-of-templates)))
	  (choose-exercise-for-each the-groups the-round)))

(define (choose-exercise-groups the-template the-count)
  (if (>= the-count (length the-template))
      the-template
      (list-range the-template 0 the-count)))

(define (choose-the-exercise a-group the-round)
  (let* ((number-of-exercises (length a-group))
	 (the-index (remainder the-round number-of-exercises))
	 (the-exercise (list-ref a-group the-index)))
    (list the-exercise)))

(define (choose-workout-template count)
  (let* ((index (remainder count number-of-templates))
	 (pre-template (list-ref all-the-templates index)))
    (if (random? pre-template)
	(randomized-template count)
	pre-template)))

(define (classify-at-1-level exercises level)
  (if (null? exercises)
      '()
      (let* ((1-exercise (car exercises))
	     (exercise-with-level (classify-1 1-exercise level))
	     (remaining-exercises (cdr exercises))
	     (remaining-exercises-with-levels (classify-at-1-level remaining-exercises level)))
	(append (list exercise-with-level) remaining-exercises-with-levels))))

(define (classify-at-different-levels next-level-exercises most-recent-level-exercises level)
  (let* ((classified-next (classify-at-1-level next-level-exercises level))
	 (most-recent-level (- level 1))
	 (classified-most-recent (classify-at-1-level most-recent-level-exercises most-recent-level)))
    (append classified-next classified-most-recent)))

(define (classify-1 exercise level)
  (cond ((string=? "cardio" exercise) (cardiovascular level))
	((string=? "meditate" exercise) (meditation level))
	(else (string-append "Perform a round of " exercise " with " (weights level)))))

(define (choose-exercises-of-the-day day-count)
  (let* ((workout-template (choose-workout-template day-count))
	 (chosen-exercises (choose-exercises-from-template workout-template day-count)))
    (determine-levels chosen-exercises day-count workout-template)))

(define (choose-exercises-from-template the-template day-count)
  (let* ((included-groups (choose-exercise-groups the-template day-count)))
    (choose-exercises-from-groups included-groups day-count)))

(define (determine-levels chosen-exercises the-count the-template)
  (let* ((exercise-count (length chosen-exercises))
	 (next-level-count (number-at-next-level the-count exercise-count))
	 (minimum-most-recent-level-index next-level-count)
	 (next-level-exercises (list-range-with-possible-null chosen-exercises
							      0
							      next-level-count))
	 (most-recent-level-exercises (list-range-with-possible-null chosen-exercises
								     minimum-most-recent-level-index
								     exercise-count))
	 (template-length (length the-template))
	 (the-round (whole-/ the-count template-length)))
    (if (> the-round 0)
	(if (= (remainder the-count template-length) 0)
	    (set! the-round (- the-round 1))))
    (classify-at-different-levels next-level-exercises
				  most-recent-level-exercises
				  the-round)))

(define (exclude the-first-A out-of-every-B from-C)
  (let* ((exclusion-count (calculate-exclusions out-of-every-B from-C))
	 (number-excluded (* the-first-A exclusion-count)))
    (- from-C number-excluded)))

(define (exercise-message prando-date)
  (let* ((day-count (calculate-day-count prando-date))
	 (exercises-&-levels (choose-exercises-of-the-day day-count)))
    (print (string-join exercises-&-levels "\n"))))

(define (prando-date-of scheme-date)
  (let* ((prando-day-0 (make-date 0 0 0 0 15 9 1991))
	 (difference (date-difference scheme-date prando-day-0))
	 (milli-difference (time->milliseconds difference))
	 (second-difference (whole-/ milli-difference 1000))
	 (day-difference (whole-/ second-difference 86400))
	 (calendar-day-difference (truncate day-difference)))
    (inexact->exact calendar-day-difference)))

(define (list-range the-list start end)
  (drop (take the-list end) start))

(define (list-range-with-possible-null the-list start end)
  (let* ((the-list-length (length the-list))
	 (real-start (min start the-list-length))
	 (real-end (min end the-list-length)))
    (list-range the-list real-start real-end)))

(define (meditation level)
  (let* ((minutes (+ level 1)))
    (if (<= minutes 30)
	(string-append "Meditate for " (number->string minutes) " minutes in the morning")
	(string-append "Meditate for 30 minutes in the morning and "
		       (number->string (- minutes 30))
		       " minutes in the evening"))))

(define (number-at-next-level the-day-count the-exercise-count)
  (let* ((the-remainder (remainder the-day-count the-exercise-count)))
      (if (= the-remainder 0)
	  the-exercise-count
	  the-remainder)))

(define number-of-templates (length all-the-templates))

(define (random? the-list)
  (if (= (length the-list) 1)
      (let* ((the-string (list-ref the-list 0)))
	(string=? the-string "randomized"))
      #f))

(define (randomized-template count)
  (let* ((shuffled (insertion-shuffle-list random-workout))
	 (complete-template (cons meditate (cons cardio shuffled))))
    (if (>= count (length complete-template))
	complete-template
	(list-range complete-template 0 count))))

(define (rest-day? prando-date)
  (if (= (remainder prando-date 8) 0)
      #t
      (let* ((prando-week (whole-/ prando-date 8)))
	(= (remainder prando-week 8) 0))))

(define (rest-message prando-date)
  (print "Take the day off; just check Your weight, body fat percentage, neck, waist, and hips."))

(define (run prando-date)
  (display "For prando date ")
  (display (number->string prando-date))
  (print ":\n")
  (if (rest-day? prando-date)
      (rest-message prando-date)
      (exercise-message prando-date))
  (print))

(define (test-run prando-date)
  (if (> prando-date 8100)
      (exit))
  (run prando-date)
  (test-run (+ prando-date 1)))

(define (shovelglove? the-list)
  (if (= (length the-list) 1)
      (let* ((the-string (list-ref the-list 0)))
	(string=? the-string "shovelgloving"))
      #f))

(define (weights number)
  (if (= number 0)
      "just the bar"
      (let* ((the-weight (* number 2.5))
	     (weight-string (number->string the-weight)))
	(string-append weight-string " lbs."))))

(define (whole-/ n d)
  (let* ((raw-fraction (/ n d))
	 (whole-value (floor raw-fraction)))
    (inexact->exact whole-value)))

;(run (prando-date-of (current-date)))
(test-run 8000)