-
Notifications
You must be signed in to change notification settings - Fork 5
Learn Try Scheme
Jacques Nomssi edited this page Feb 18, 2018
·
30 revisions
Code from various sources that works directly with the interpreter:
In logical expressions, everything except #f is true
#f is false
#t is true
like global field-symbols in ABAP
(define pi 3.1415926535897932384626433832795)
;; alternative definition of pi: (define pi (* 4 (atan 1.0)))
(define a 1)
(define b 2)
Evaluate a symbol a => 1 x => Eval: Symbol x is unbound
No restrictions on symbol's name
(define ! not)
=> !
(! #f)
=> #t
A string is a group of characters enclosed in double quotation marks.
;; valid string: "I am a string"
(display "Hello World")
=> Hello World
LISP uses prefix notation. Expression a * ( b + c ) / d will be written as (/ (* a (+ b c) ) d)
(+ 1 2)
=> 3
(+ 1 'foo)
=> Eval: foo is not a number [+]
; infix notation is (60 * 9 / 5) + 32
(+ (* (/ 9 5) 60) 32)
=> 140.0
; infix 2 * cos( 0 ) * ( 4 + 6 )
(* 2 (cos 0) (+ 4 6))
=> 20
(+ 3 (* 4 5))
=> 23
(list a b)
=> ( a b )
Examples from the Racket Guide:
(length (list "hop" "skip" "jump")) ; count the elements
==> 3
(list-ref (list "hop" "skip" "jump") 0) ; extract by position
==> "hop"
(list-ref (list "hop" "skip" "jump") 1)
==> "skip"
(append (list "hop" "skip") (list "jump")) ; combine lists
==> ("hop" "skip" "jump")
(reverse (list "hop" "skip" "jump")) ; reverse order
==> '("jump" "skip" "hop")
(member "fall" (list "hop" "skip" "jump")) ; check for an element
==> #f
(define c '(1 2 3 4))
=> c
(set-cdr! (cddr c) c)
=> nil
c
=> #0 = ( 1 2 3 . #0# )
(vector 'a 'b)
=> #( a b )
(define x 3)
=> x
;; x greater or equal to 5?
(<= 5 x )
=> #f
;; x less or equal to 16?
(<= x 16 )
=> #t
;; x between 2 and 16 ?
(<= 2 x 16 )
=> #t
;; alternative
(and (<= 2 x ) (<= x 16))
(let (declarations)
... body.. )
surround the entire list of declarations with matching parentheses or brackets
(let ((a 5)
(b 6))
(+ a b))
=> 11
(let ((x 5))
(let ((x 2)
(y x))
(list y x)))
=> ( 5 2 )
(let ((x 2))
(let ((x 3) (y x))
y)
=> 2
let* binds in sequence, referencing previously bound local variables
(let ((x 2))
(let* ((x 3) (y x))
y)
=> 3
(let* ((a 5)
(b (+ a 2)))
b)
=> 7
;; Functions
;; (define (function_name arguments)
;; ... function body ... )
;; ... body ... )
(define (f n)
(+ n 10) )
(f 5)
;; the quote function - the argument is NOT evaluated
;; it is kept as a LIST of argument
(quote (+ 3 (* 4 5)) )
=> (+ 3 (* 4 5))
;; the single quotation mark = quote function
'(+ 3 (* 4 5))
=> (+ 3 (* 4 5))
;; https://see.stanford.edu/materials/icsppcs107/30-Scheme-Functions.pdf
;; Function: celsius->fahrenheit
;; -----------------------------
;; Simple conversion function to bring a Celsius
;; degree amount into Fahrenheit.
;;
(define (celsius->fahrenheit celsius)
(+ (* 1.8 celsius) 32)
;; https://see.stanford.edu/materials/icsppcs107/30-Scheme-Functions.pdf
;; Predicate function: _leap-year?_
;; ------------------------------
;; Illustrates the use of the 'or, 'and, and 'not special forms. The question mark after the
;; function name isn't required, it's just customary to include a question mark at the end
;; of a function that returns a true or false.
;;
;; A year is a leap year if it's divisible by 400, or if it's divisible by 4 but not by 100.
;;
(define (leap-year? year)
(or (and (zero? (remainder year 4))
(not (zero? (remainder year 100))))
(zero? (remainder year 400))))
;; abs
(define (abs x)
( (if (< x 0)
-
+ ) x ))
(define x 1)
(define (f x) (g 2))
(define (g y) (+ x y))
(f 5)
=> 3 ; not 7
(define (factorial n)
(if (zero? n)
1
(* n (factorial (- n 1)))))
or
(define factorial
(lambda (n)
(if (= n 0)
1
(* n (factorial (- n 1))))))
;; Square
(define (square x) (* x x))
(square 11)
=> 121
;; Average
(define (average x y)
(/ (+ x y) 2))
(average 23 35)
=> 29
(let ((x 5))
(define foo (lambda (y) (bar x y)))
(define bar (lambda (a b) (+ (* a b) a)))
(foo (+ x 3)))
=> 45
;; reverse list
(define reverse
(lambda (ls)
(let rev ((ls ls) (new '()))
(if (null? ls)
new
(rev (cdr ls) (cons (car ls) new))))))
(define (atom? x) (not (or (pair? x) (null? x) (vector? x))))
(define (flatten x)
(letrec
((f (lambda (x r)
(cond ((null? x) r)
((atom? x) (cons x r))
(else (f (car x)
(f (cdr x) r)))))))
(f x ())))
(flatten '((a) (b (c)) (d (e (f)))))
=> ( a b c d e f )
;
; primes
; By Ozan Yigit
;
(define (interval-list m n)
(if (> m n)
'()
(cons m (interval-list (+ 1 m) n))))
(define (sieve l)
(define (remove-multiples n l)
(if (null? l)
'()
(if (= (modulo (car l) n) 0) ; division test
(remove-multiples n (cdr l))
(cons (car l)
(remove-multiples n (cdr l))))))
(if (null? l)
'()
(cons (car l)
(sieve (remove-multiples (car l) (cdr l))))))
(define (primes<= n)
(sieve (interval-list 2 n)))
Now execute (primes<= 300)
;; Square Root
;; https://mitpress.mit.edu/sicp/chapter1/node9.html
(define (sqrt x)
(sqrt-iter 1.0 x))
(define (sqrt-iter guess x)
(if (good-enough? guess x)
guess
(sqrt-iter (improve guess x) x)))
(define (good-enough? guess x)
(< (abs (- (square guess) x)) 0.001))
(define (improve guess x)
(average guess (/ x guess)))
(define (quadratic-formula a b c)
;; find the roots x of a quadratic equation a x**2 + b * x + c = 0
(let ([minusb (- 0 b)]
[radical (sqrt (- (* b b) (* 4 (* a c))))]
[divisor (* 2 a)])
(let ([root1 (/ (+ minusb radical) divisor)]
[root2 (/ (- minusb radical) divisor)])
; create a pair with both solutions
(cons root1 root2))))
now test
(quadratic-formula 2 -4 -6)
=> ( 3 . -1 )
;----------------------------------------------------------
;; guess my number between 1 and 100
(define *big* 100)
(define *small* 1)
(define (guess) (round (/ (+ *big* *small*) 2)) )
(define (larger) (set! *small* (+ 1 (guess))) (guess))
(define (smaller) (set! *big* (- (guess) 1)) (guess))
(define (restart) (set! *big* 100) (set! *small* 1) (guess))
; my number is 16 - the logic needs 7 steps
(restart) ; 51
(smaller) ; 26
(smaller) ; 13
(larger) ; 20
(smaller) ; 17
(smaller) ; 15
(larger) ; 16
;--------- now your number
(restart) ; 51
IO test © 1996 by A. Aaby
The purpose of the following function is to help balance a checkbook. The function prompts the user for an initial balance. Then it enters the loop in which it requests a number from the user, subtracts it from the current balance, and keeps track of the new balance. Deposits are entered by inputting a negative number. Entering zero (0) causes the procedure to terminate and print the final balance.
(define checkbook (lambda ()
; This check book balancing program was written to illustrate
; i/o in Scheme. It uses the purely functional part of Scheme.
; These definitions are local to checkbook
(letrec
; These strings are used as prompts
((IB "Enter initial balance: ")
(AT "Enter transaction (- for withdrawal): ")
(FB "Your final balance is: ")
; This function displays a prompt then returns a value read.
(prompt-read (lambda (Prompt)
(display Prompt)
(read)))
; This function recursively computes the new balance given
; an initial balance init and a new value t.
; Termination occurs when the new value is 0.
(newbal (lambda (Init t)
(if (= t 0)
(list FB Init)
(transaction (+ Init t)))))
; This function prompts for and reads the next
; transaction and passes the information to newbal
(transaction (lambda (Init)
(newbal Init (prompt-read AT)))))
; This is the body of checkbook; it prompts for the starting balance
(transaction (prompt-read IB)))))
Now call (checkbook)
A Quine
((lambda (x)
(list x (list (quote quote) x)))
(quote (lambda (x)
(list x (list (quote quote) x)))))
;; http://www.brics.dk/RS/03/20/BRICS-RS-03-20.pdf
;; A staged quadratic-time string matcher
(define (main pattern text)
(match pattern text 0 0))
(define (match pattern text j k)
(if (= (string-length pattern) j)
(- k j)
(if (= (string-length text) k)
-1
(compare pattern text j k))))
;; Backtracking also using one character of negative information
(define (compare pattern text j k)
(if (equal? (string-ref text k)
(string-ref pattern j))
(match pattern text (+ j 1) (+ k 1))
(let ([s (rematch-neg pattern j)])
(if (= s -1)
(match pattern text 0 (+ k 1))
(compare pattern text s k)))))
(define (rematch-neg pattern i)
(if (= i 0)
-1
(let ([j (rematch pattern i)])
(if (equal? (string-ref pattern j)
(string-ref pattern i))
(rematch-neg pattern j)
j))))
; (define (compare pattern text j k)
; (if (equal? (string-ref pattern j) (string-ref text k))
; (match pattern text (+ j 1) (+ k 1))
; (let ([s (rematch pattern j)])
; (if (= s -1)
; (match pattern text 0 (+ k 1))
; (compare pattern text s k)))))
;; Compositional backtracking suitable for fast partial evaluation
(define (rematch pattern i)
(if (= i 0)
-1
(letrec ([try-subproblem
(lambda (j)
(if (= j -1)
0
(if (equal? (string-ref pattern j)
(string-ref pattern (- i 1)))
(+ j 1)
(try-subproblem (rematch pattern j)))))])
(try-subproblem (rematch pattern (- i 1))))))
More Examples from https://github.com/hmgle/yascm