14 KiB
14 KiB
| title | author | date | description | updated | tags |
|---|---|---|---|---|---|
| Some Scheming | Collin J. Doering | 2013-12-08 | An Article about scheme | 2013-12-08 | programming, scheme |
Unidentified vessel travelling at sub warp speed, bearing 235.7. Fluctuations in energy readings from it, Captain. All transporters off. A strange set-up, but I'd say the graviton generator is depolarized. The dark colourings of the scrapes are the leavings of natural rubber, a type of non-conductive sole used by researchers experimenting with electricity. The molecules must have been partly de-phased by the anyon beam.
;; 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)))
Sensors indicate human life forms 30 meters below the planet's surface. Stellar flares are increasing in magnitude and frequency. Set course for Rhomboid Dronegar 006, warp seven. There's no evidence of an advanced communication network. Total guidance system failure, with less than 24 hours' reserve power. Shield effectiveness has been reduced 12 percent. We have covered the area in a spherical pattern which a ship without warp drive could cross in the given time.
Deflector power at maximum. Energy discharge in six seconds. Warp reactor core primary coolant failure. Fluctuate phaser resonance frequencies. Resistance is futile. Recommend we adjust shield harmonics to the upper EM band when proceeding. These appear to be some kind of power-wave-guide conduits which allow them to work collectively as they perform ship functions. Increase deflector modulation to upper frequency band.
#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!")))
(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)))
;; 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 (merge xs ys)
(cond [(and (empty? xs) (empty? ys)) empty]
[(empty? xs) ys]
[(empty? ys) xs]
[(< (first xs) (first ys)) (cons (first xs) (merge (rest xs) ys))]
[(equal? (first xs) (first ys))
(cons (first xs) (cons (first ys) (merge (rest xs) (rest ys))))]
[else (cons (first ys) (merge xs (rest ys)))]))
(define (merge-sort xs)
(cond [(empty? xs) empty]
[(empty? (rest xs)) xs]
[else (merge (merge-sort (take xs (quotient (length xs) 2)))
(merge-sort (drop xs (quotient (length xs) 2))))]))
(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 '())))
Sensors indicate human life forms 30 meters below the planet's surface. Stellar flares are increasing in magnitude and frequency. Set course for Rhomboid Dronegar 006, warp seven. There's no evidence of an advanced communication network. Total guidance system failure, with less than 24 hours' reserve power. Shield effectiveness has been reduced 12 percent. We have covered the area in a spherical pattern which a ship without warp drive could cross in the given time.
Deflector power at maximum. Energy discharge in six seconds. Warp reactor core primary coolant failure. Fluctuate phaser resonance frequencies. Resistance is futile. Recommend we adjust shield harmonics to the upper EM band when proceeding. These appear to be some kind of power-wave-guide conduits which allow them to work collectively as they perform ship functions. Increase deflector modulation to upper frequency band.