#lang racket

;; File: rdm.rkt
;; Date: Oct 25, 2010
;; Author: Collin J. Doering <rekahsoft@gmail.com
;; Description: Random source file to experiment while learning racket (plt scheme)

;; factorial int[>=0] -> int[>=0]
;; Purpose: returns the factorial of the given positive (or zero) integer
;; Examples/Tests:

(define (factorial n)
  (define (factorial-helper n acc)
            (cond [(<= n 1) acc]
                  [else (factorial-helper (- n 1) (* acc n))]))
  (if (integer? n)
      (factorial-helper n 1)
      (error "Expects argument to be an integer!")))

;; factorial function written using pattern matching
(define (factorial1 n)
  (define/match (fac i acc)
      [(0 _) acc]
      [(n _) (fac (- n 1) (* n acc))])
  (fac n 1))

(define factorial!
  (letrec ([fact-helper (lambda (n acc)
			  (if (<= n 1) acc (fact-helper (- n 1) (* acc n))))]
	   [fact! (lambda (n)
		    (fact-helper n 1))])
    fact!))

(define (factorial-close [n 0])
  (letrec ([acc 1]
	   [x 1]
	   [fac-c (lambda ()
		    (cond [(> x n) (set! n (+ n 1)) acc]
			  [else (set! acc (* x acc))
				(set! x (+ x 1))
				(fac-c)]))])
    fac-c))

(define (sum-digits n [base 10])
  (letrec ([sum-digits-helper
	    (lambda (n acc)
	      (cond [(zero? (floor (/ n base))) (+ acc (remainder n base))]
		    [else (sum-digits-helper (floor (/ n base)) (+ acc (remainder n base)))]))])
    (sum-digits-helper n 0)))

;; fibinocci sequences
;; Very slow...big-O anaylsis of O(2^n) (not 100% sure tho)
(define (fib n)
  (cond [(<= n 0) 0]
	[(= n 1) 1]
	[else (+ (fib (- n 1)) (fib (- n 2)))]))

;; fibinocci sequence...but implemented smart ;) haven't looked at the big-O analysis yet
(define (fast-fib n)
  (letrec ([fib-lst empty]
	   [gen-fib (lambda (n x)
		      (cond [(> x n) (first fib-lst)]
			    [(= x 0) (set! fib-lst (cons 0 empty))
			     (gen-fib n (+ x 1))]
			    [(= x 1) (set! fib-lst (cons 1 fib-lst))
			     (gen-fib n (+ x 1))]
			    [else (let ([fibx (+ (first fib-lst) (second fib-lst))])
				    (set! fib-lst (cons fibx fib-lst))
				    (gen-fib n (+ x 1)))]))])
    (gen-fib n 0)))

;; another fibinocci sequence function but with significantly improved memory performance :D (TODO: big-O analysis)
(define (fast-mem-fib n)
  (letrec ([fib-dot-lst empty]
	   [gen-fib (lambda (n x)
		      (cond [(> x n) (car fib-dot-lst)]
			    [(= x 0) (set! fib-dot-lst (cons 0 empty))
			             (gen-fib n (+ x 1))]
			    [(= x 1) (set! fib-dot-lst (cons 1 0))
			             (gen-fib n (+ x 1))]
			    [else (let* ([fst (car fib-dot-lst)]
					 [scd (cdr fib-dot-lst)]
					 [fibx (+ fst scd)])
				    (set! fib-dot-lst (cons fibx fst))
				    (gen-fib n (+ x 1)))]))])
    (gen-fib n 0)))

;; fibinocci closure..pretty much the same as fast-mem-fib but returns a gen-fib like function that takes
;; no paramters but instead encapsulates the values for n and x thus creating a fibinocci closure starting at n
(define (fibc [n 0])
  (letrec ([fib-dot-lst empty]
	   [x 0]
	   [gen-fib-c (lambda ()
			(cond [(> x n) (set! n (+ n 1))
			               (car fib-dot-lst)]
			      [(= x 0) (set! fib-dot-lst (cons 0 empty))
			               (set! x (+ x 1))
			               (gen-fib-c)]
			      [(= x 1) (set! fib-dot-lst (cons 1 0))
			               (set! x (+ x 1))
			               (gen-fib-c)]
			      [else (let* ([fst (car fib-dot-lst)]
					   [scd (cdr fib-dot-lst)]
					   [fibx (+ fst scd)])
				               (set! fib-dot-lst (cons fibx fst))
					       (set! x (+ x 1))
				               (gen-fib-c))]))])
    gen-fib-c))

;; pow num num -> num
;; Purpose: given two real numbers x and n returns x^n
;; Examples/Tests:

(define (pow x n)
  (define (pow-helper x n acc)
    (cond [(= n 0) acc]
          [(> n 0) (pow-helper x (- n 1) (* acc x))]
          [(< n 0) (pow-helper x (+ n 1) (* acc (/ 1 x)))]))
  (pow-helper x n 1))

;; Expandtion of the below macro:
;; (define (natural-number? n)
;;   (if (and (interger? n) (>= n 0) #t #f)))

(define natural-number?
  (lambda (n)
    (if (and (integer? n) (>= n 0)) #t #f)))

(define average-num
  (lambda lst
    (/ (apply + lst) (length lst))))

(define (average-list lst)
  (define (sum-list lst acc)
    (cond [(empty? lst) acc]
          [else (sum-list (rest lst) (+ acc (first lst)))]))
  (/ (sum-list lst 0) (length lst)))

;; increasing common interval
(define (icd-interval i j d)
  (define (icd-interval-helper i j d acc)
    (cond [(> i j) acc]
          [else (icd-interval-helper (+ i d) j d (cons i acc))]))
  (if (> i j)
      (error "i > j for a increasing common interval list to be generated!")
      (reverse (icd-interval-helper i j d empty))))

;; interval num num -> listof(num)
;; Purpose: Given two 
(define (interval i j)
  (define (interval-helper i j acc)
    (cond [(> i j) acc]
          [else (interval-helper (+ i 1) j (cons i acc))]))
  (reverse (interval-helper i j empty)))

(define (repeat f n)
  (define (rep i acc)
    (cond [(<= i 0) acc]
          [else (rep (- i 1) (cons (f) acc))]))
  (rep n '()))

;; common poduct interval
(define (cp-interval i j m)
  (map (lambda (x) (if (= x 0) x (* m x))) (interval i j)))

;; letrec is cool :P
;; (letrec [(fact! (lambda (n) (if (<= n 1) 1 (* n (fact! (- n 1))))))]
;;    (fact! 5))

;; take a looksi at racket/tcp and racket/ssl

(define (client)
  (let-values ([(s-in s-out) (tcp-connect "localhost" 1342)])
    (let ([read-and-display
           (lambda (in-port)
             (let ([responce (read in-port)])
               (display responce)
               (newline)))])
      (read-and-display s-in)
      (write (read-line (current-input-port) 'return-linefeed) s-out)
      (close-output-port s-out)
      (read-and-display s-in)
      (close-input-port s-in))))

;; server
(define listener (tcp-listen 1342))
(let echo-server ()
  (define-values (in out) (tcp-accept listener))
  (thread (lambda ()
            (copy-port in out)
            (close-output-port out)))
  (echo-server))

;; server (Version 2)
(define listener (tcp-listen 1342))
(define (server)
  (let-values ([(in out) (tcp-accept listener)])
    (thread (lambda ()
              (copy-port in out)
              (close-output-port out))))
  (server))

(define (read-it-all f-in [acc ""])
	   (let ([line (read-line f-in)])
	     (if (eof-object? line) (begin acc (close-input-port f-in)) (read-it-all f-in (string-append acc line "\n")))))

;; takes a lowercase char and returns it shifted by 13 characters
(define (rot-char char)
	   (cond [(or (char-symbolic? char) (char-numeric? char) (char-whitespace? char)) char]
		 [(< (char->integer char) 109) (integer->char (modulo (+ (char->integer char) 13) 122))]
		 [else (integer->char (+ 96 (modulo (+ (char->integer char) 13) 122)))]))

(define (rot13 str)
  (letrec ([rot13-helper (lambda (lst acc)
			   (cond [(empty? lst) acc]
				 [(char-upper-case? (first lst)) (rot13-helper (rest lst) (cons (char-upcase (rot-char (char-downcase (first lst)))) acc))]
				 [else (rot13-helper (rest lst) (cons (rot-char (first lst)) acc))]))])
    (list->string (reverse (rot13-helper (string->list str) empty)))))

;; a much better written rot13 which takes advantage of testing intervals
(define (best-rot13 str)
  (letrec
      ;; add-to-char char int -> char
      ;; Purpose: takes the unicode value of the given char and adds n evauluating to the char the additions represents
      ([add-to-char (lambda (char n)
		      (integer->char (+ n (char->integer char))))]
       ;; best-rot listof(char) (or listof(char) acc) -> listof(char)
       ;; Purpose: Given a list of characters returns the rot13 representation
       [best-rot
	(lambda (lst acc)
	  (cond [(empty? lst) acc]
		[(<= 65 (char->integer (first lst)) 77) (best-rot (rest lst) (cons (add-to-char (first lst) 13) acc))]
		[(<= 78 (char->integer (first lst)) 90) (best-rot (rest lst) (cons (add-to-char (first lst) -13) acc))]
		[(<= 97 (char->integer (first lst)) 109) (best-rot (rest lst) (cons (add-to-char (first lst) 13) acc))]
		[(<= 110 (char->integer (first lst)) 122) (best-rot (rest lst) (cons (add-to-char (first lst) -13) acc))]
		[else (best-rot (rest lst) (cons (first lst) acc))]))])
    (list->string (reverse (best-rot (string->list str) empty)))))

;; map defined in terms of foldr
(define (foldr-map fn lst)
    (foldr (lambda (x y) (cons (fn x) y)) empty lst))

(define (foldr-copy lst)
  (foldr cons empty lst))

(define (compose fn1 fn2)
  (lambda (x) (fn1 (fn2 x))))

(define (foldr-append lst1 lst2)
  (foldr cons lst2 lst1))

(define (foldr-length lst)
  (foldr (lambda (x y) (+ y 1)) 0 lst))

(define (foldr-sum lst)
  (foldr + 0 lst))

;; broken..needs to know the number of digits of the number n
(define (nth-digit n i)
  (let ([f (/ n (expt 10 (+ i 1)))])
    (floor (* 10 (- f (floor f))))))

(define (random-list n)
  (define (randlst i acc)
    (cond [(<= i 0) acc]
          [else (randlst (sub1 i) (cons (random n) acc))]))
  (randlst n '()))

(define (append-all a b)
  (cond [(and (list? a) (list? b)) (append a b)]
	[(list? a) (append a (list b))]
	[(list? b) (cons a b)]
	[else (list a b)]))

(define (my-append xs ys)
  (cond [(empty? xs) ys]
	[else (cons (first xs) (my-append (rest xs) ys))]))

(define (my-append2 xs ys)
  (define (my-append2-h sx acc)
    (cond [(empty? sx) acc]
	  [else (my-append2-h (rest sx) (cons (first sx) acc))]))
  (my-append2-h (reverse xs) ys))

(define (my-append3 xs ys)
  (foldr cons ys xs))

;; TODO: do the big-oh analysis of the flatten functions below
(define (my-flatten xs)
  (cond [(empty? xs) '()]
	[(list? (first xs)) (append (my-flatten (first xs)) (my-flatten (rest xs)))]
	[else (cons (first xs) (my-flatten (rest xs)))]))

(define (my-flatten2 xs)
  (define (my-flatten2-h xs acc)
    (cond [(empty? xs) acc]
	  [(list? (first xs))
	     (my-flatten2-h (rest xs) (append (my-flatten2-h (first xs) '()) acc))]
	  [else (my-flatten2-h (rest xs) (cons (first xs) acc))]))
  (reverse (my-flatten2-h xs '())))

(define (rpn-calc xs)
  (define (symbol->operator s)
    (cond [(eq? s '+) +]
          [(eq? s '-) -]
          [(eq? s '*) *]
          [(eq? s '/) /]))
  (define (symbol-urinary-op? s)
    (cond [(eq? s '!) #t]
          [else #f]))
  (define (symbol-urinary->op s)
    (cond [(eq? s '!) (lambda (n) (foldr * 1 (if (>= n 0) (range 1 (+ n 1)) (range n 0))))]))
  (define/match (rpn ys acc)
    [('() (cons a '())) a]
    [('() _) (error "Not a valid RPN expression")]
    [((cons y ys) acc) #:when (number? y) (rpn ys (cons y acc))]
    [((cons y ys) (cons a acc)) #:when (symbol-urinary-op? y)
     (rpn ys (cons ((symbol-urinary->op y) a) acc))]
    [((cons y ys) (cons a1 (cons a2 acc))) #:when (symbol? y)
     (rpn ys (cons ((symbol->operator y) a2 a1) acc))])
  (rpn xs '()))