text:
Scheme is a small language with limited libraries. This Standard Prelude provides several libraries used in Programming Praxis: list utilities, list comprehensions, pattern matching, structures, matrices, hash tables, dictionaries, input/output, strings, sorting, higher-order functions, math functions, bits, random numbers, control flow, date arithmetic,unit testing, and miscellaneous. This code should work directly in any R5RS Scheme. In R6RS Scheme, it will be useful to wrap the code using module system, based on local preference. The Standard Prelude changes from time to time, so check back often. The code is collected at http://programmingpraxis.codepad.org/hZnG9BCP.
List Utilities
Lists are ubiquitous in Scheme, so it is useful to have available a collection of utility functions that operate on lists.
Take returns a newly-allocated list containing the first n elements of the list xs; if xs has less than n elements, return all of them.
Drop is the opposite of
take, returning all elements of a list xs except the first n.
Split combines
take and
(define (take n xs)
(let loop ((n n) (xs xs) (ys '()))
(if (or (zero? n) (null? xs))
(reverse ys)
(loop (- n 1) (cdr xs)
(cons (car xs) ys)))))
(define (drop n xs)
(let loop ((n n) (xs xs))
(if (or (zero? n) (null? xs)) xs
(loop (- n 1) (cdr xs)))))
(define (split n xs)
(let loop ((n n) (xs xs) (zs '()))
(if (or (zero? n) (null? xs))
(values (reverse zs) xs)
(loop (- n 1) (cdr xs) (cons (car xs) zs)))))
drop-while, and
split-while are similar to
drop and
split, but instead of counting elements, they operate on that prefix of the elements x of xs for which
(pred? x
) is non-
(define (take-while pred? xs)
(let loop ((xs xs) (ys '()))
(if (or (null? xs) (not (pred? (car xs))))
(reverse ys)
(loop (cdr xs) (cons (car xs) ys)))))
(define (drop-while pred? xs)
(let loop ((xs xs))
(if (or (null? xs) (not (pred? (car xs)))) xs
(loop (cdr xs)))))
(define (split-while pred? xs)
(let loop ((xs xs) (ys '()))
(if (or (null? xs) (not (pred? (car xs))))
(values (reverse ys) xs)
(loop (cdr xs) (cons (car xs) ys)))))
Cons* is similar to
list, but handles the last pair differently;
(list 1 2 3) forms the list
(1 2 3 . ()), but
(cons* 1 2 3) forms the list
(1 2 . 3):
(define (cons* first . rest)
(let loop ((curr first) (rest rest))
(if (null? rest) curr
(cons curr (loop (car rest) (cdr rest))))))
Folds use a user-specified function to reduce a list of values to a single value, and are one of the fundamental idioms of functional programming.
Fold-left works left-to-right through the list xs, applying the binary op function to base and the first element of xs, then applying the binary op function to the result of the first op function and the second element of xs, and so on, at each step applying the binary op function to the result of the previous op function and the current element of xs;
fold-right works the same way, but right-to-left.
(define (fold-left op base xs)
(if (null? xs)
(fold-left op (op base (car xs)) (cdr xs))))
(define (fold-right op base xs)
(if (null? xs)
(op (car xs) (fold-right op base (cdr xs)))))
(range [first
] past
]) function takes three arguments and returns a list of numbers starting from first and ending before past, incrementing each number by step. If step is omitted, it defaults to 1 if first is less than past, and -1 otherwise; if first is also omitted, it defaults to 0. Arguments may be of any numeric type.
(define (range . args)
(case (length args)
((1) (range 0 (car args) (if (negative? (car args)) -1 1)))
((2) (range (car args) (cadr args) (if (= <=)))
(let loop ((x(car args)) (xs '()))
(if (le? (cadr args) x)
(reverse xs)
(loop (+ x (caddr args)) (cons x xs))))))
(else (error 'range "unrecognized arguments"))))
Mappend is like
map, but assembles its pieces with
append rather than
Iterate repeatedly evaluates a function f against the base values bs, after each iteration shifting the base values left by removing the first and appending the newly-calculated value at the end, returning the first n results in a list:
(define (mappend f . xss) (apply append (apply map f xss)))
(define (iterate n f . bs)
(let loop ((n n) (b (car bs)) (bs (cdr bs)) (xs '()))
(if (zero? n) (reverse xs)
(let ((new-bs (append bs (list (apply f b bs)))))
(loop (- n 1) (car new-bs) (cdr new-bs) (cons b xs))))))
For instance,
(define (fib n) (iterate n + 1 1)) defines a function that calculates the first n fibonacci numbers
(filter pred?
) function returns a newly-allocated list that contains only those elements x of xs for which
(pred? x
) is true. The
(remove x
) function removes all occurrences of x from the list xs, using
equal? to make comparisons:
(define (filter pred? xs)
(let loop ((xs xs) (ys '()))
(cond ((null? xs) (reverse ys))
((pred? (car xs))
(loop (cdr xs) (cons (car xs) ys)))
(else (loop (cdr xs) ys)))))
(define (remove x xs)
(let loop ((xs xs) (zs '()))
(cond ((null? xs) (reverse zs))
((equal? (car xs) x) (loop (cdr xs) zs))
(else (loop (cdr xs) (cons (car xs) zs))))))
Flatten takes a tree represented as a list with sub-lists and returns a list containing only the fringe elements of the tree. The two trees
(a (b c)) and
((a b) c) both cause
flatten to return
(a b c):
(define (flatten xs)
(cond ((null? xs) xs)
((pair? xs)
(append (flatten (car xs))
(flatten (cdr xs))))
(else (list xs))))
All? and
any? apply a predicate to each member of a list.
All? returns
#t if
(pred? x
) is non-
#f for every x in the input list, or
#f otherwise.
Any? returns
#f if
(pred? x
) is
#f for every x in the input list, or
#t otherwise. Both functions stop applying the predicate to elements of the input as list as soon as possible.
(define (all? pred? xs)
(cond ((null? xs) #t)
((pred? (car xs))
(all? pred? (cdr xs)))
(else #f)))
(define (any? pred? xs)
(cond ((null? xs) #f)
((pred? (car xs)) #t)
(else (any? pred? (cdr xs)))))
Zip converts multiple lists into a list of lists:
(define (zip . xss) (apply map list xss))
Cross produces the cross product of one or more lists. The implementation is a functional pearl due to Christoper Strachey, collected by Mike Spivey:
(define (cross . xss)
(define (f xs yss)
(define (g x zss)
(define (h ys uss)
(cons (cons x ys) uss))
(fold-right h zss yss))
(fold-right g '() xs))
(fold-right f (list '()) xss))
(make-list n
) function returns a newly-allocated list containing n copies of x:
(define (make-list n x)
(let loop ((n n) (xs '()))
(if (zero? n) xs
(loop (- n 1) (cons x xs)))))
It is frequently useful to calculate the sum of a list:
(define (sum xs) (apply + xs))
Maximum-by is like the built-in function
max, except that it takes a
lt? comparison function as its first argument before the items to be compared:
(define (maximum-by lt? . xs)
(let loop ((xs (cdr xs)) (current-max (car xs)))
(cond ((null? xs) current-max)
((lt? current-max (car xs))
(loop (cdr xs) (car xs)))
(else (loop (cdr xs) current-max)))))
List Comprehensions
List comprehensions join the higher-order idioms map, filter and fold into a highly useful form of syntactic sugar for performing looping computations involving lists. The Standard Prelude provides three types of list comprehension:
...)produces a possibly-null list of objects of the type returned by expr
- (sum-of expr
...)computes the sum of the elements computed by expr
- (fold-of op
...)is like
sum-of, but with a user-defined operator and base in place of the + and 0 of
Clauses may be of four types:
range [first
])— Bind var to first, first + step,
..., until reaching past, which is not included in the output. If first is not given it defaults to 0. If step is not given, it defaults to 1 if
)and -1 otherwise. First, past and step may be of any numeric type; if any of first, past or step are inexact, the length of the output list may differ from
(ceiling (- (/ (-past
) 1).
)— Loop over the elements of list-expr, in order from the start of the list, binding each element of the list in turn to var.
)— Bind var to the value obtained by evaluating expr.
)— Include in the output list only those elements x for which
)is non-
The scope of variables bound in the list comprehension is the clauses to the right of the binding clause (but not the binding clause itself) plus the result expression. When two or more generators are present, the loops are processed as if they are nested from left to right; that is, the rightmost generator varies fastest. As a degenerate case, if no generators are present, the result of a list comprehension is a list containing the result expression; thus,
(list-of 1) produces a list containing only the element 1.
List comprehensions are expanded by a macro that calls itself recursively, one level of recursion for each clause plus a final level of recursion for the base case. The complete implementation, which is based on the set constructor in Kent Dybvig's book The Scheme Programming Language, is given below:
(define-syntax fold-of
(syntax-rules (range in is)
((_ "z" f b e) (set! b (f b e)))
((_ "z" f b e (v range fst pst stp) c ...)
(let* ((x fst) (p pst) (s stp)
(le? (if (positive? s) =)))
(do ((v x (+ v s))) ((le? p v) b)
(fold-of "z" f b e c ...))))
((_ "z" f b e (v range fst pst) c ...)
(let* ((x fst) (p pst) (s (if (< x p) 1 -1)))
(fold-of "z" f b e (v range x p s) c ...)))
((_ "z" f b e (v range pst) c ...)
(fold-of "z" f b e (v range 0 pst) c ...))
((_ "z" f b e (x in xs) c ...)
(do ((t xs (cdr t))) ((null? t) b)
(let ((x (car t)))
(fold-of "z" f b e c ...))))
((_ "z" f b e (x is y) c ...)
(let ((x y)) (fold-of "z" f b e c ...)))
((_ "z" f b e p? c ...)
(if p? (fold-of "z" f b e c ...)))
((_ f i e c ...)
(let ((b i)) (fold-of "z" f b e c ...)))))
(define-syntax list-of (syntax-rules ()
((_ arg ...) (reverse (fold-of
(lambda (d a) (cons a d)) '() arg ...)))))
(define-syntax sum-of (syntax-rules ()
((_ arg ...) (fold-of + 0 arg ...))))
The list comprehensions given here extend the usual notion of list comprehensions with the
fold-of comprehension. Another extension is
nth-of, which expands a list comprehension and returns the
nth item:
(define-syntax nth-of
(syntax-rules ()
((_ n expr clause ...)
(let ((nth n))
(lambda (return)
(lambda (fst snd)
(if (zero? nth) (return snd)
(begin (set! nth (- nth 1)) snd)))
#f expr clause ...)))))))
Pattern Matching
Pattern matching provides syntactic sugar to destructure lists, select alternatives, and bind variables, and is provided by the
list-match macro. The syntax
(list-match expr
...) takes an input expr that evaluates to a list. Clauses are of the form
] expr
), consisting of a pattern that matches a list of a particular shape, an optional fender that must succeed if the pattern is to match, and an expr that is evaluated if the pattern matches. There are four types of patterns:
()— Matches the null list.
...)— Matches a list with length exactly equal to the number of pattern elements.
... .patRest
)— Matches a list with length at least as great as the number of pattern elements before the literal dot. PatRest is a list containing the remaining elements of the input list after the initial prefix of the list before the literal dot.
- pat — Matches an entire list. Should always appear as the last clause; it's not an error to appear elsewhere, but subsequent clauses could never match.
Each pattern element may be:
- An identifier — Matches any list element. Additionally, the value of the list element is bound to the variable named by the identifier, which is in scope in the fender and expr of the corresponding clause. Each identifier in a single pattern must be unique.
- A literal underscore — Matches any list element, but creates no bindings.
- A constant — Matches if the expression equals the constant value, but creates no bindings.
- A quote expression — Matches if the expression equals the quote expression, but creates no bindings.
- A quasiquote expression — Matches if the expression equals the quasiquote expression, but creates no bindings.
All comparisons are made with
equal?. The patterns are tested in order, left to right, until a matching pattern is found; if fender is present, it must evaluate as non-
#f for the match to be successful. Pattern variables are bound in the corresponding fender and expression. Once the matching pattern is found, the corresponding expression is evaluated and returned as the result of the match. An error is signaled if no pattern matches the input list.
Pattern matching is performed by a macro that expands into a
cond expression with one clause per pattern; an auxiliary macro handles the various types of pattern elements. The complete implementation, which is based on an idea of Jos Koot, is given below:
(define-syntax list-match
(syntax-rules ()
((_ expr (pattern fender ... template) ...)
(let ((obj expr))
(cond ((list-match-aux obj pattern fender ...
(list template)) => car) ...
(else (error 'list-match "pattern failure")))))))
(define-syntax list-match-aux
(lambda (stx)
(define (underscore? x)
(and (identifier? x) (free-identifier=? x (syntax _))))
(syntax-case stx (quote quasiquote)
((_ obj pattern template)
(syntax (list-match-aux obj pattern #t template)))
((_ obj () fender template)
(syntax (and (null? obj) fender template)))
((_ obj underscore fender template)
(underscore? (syntax underscore))
(syntax (and fender template)))
((_ obj var fender template)
(identifier? (syntax var))
(syntax (let ((var obj)) (and fender template))))
((_ obj (quote datum) fender template)
(syntax (and (equal? obj (quote datum)) fender template)))
((_ obj (quasiquote datum) fender template)
(syntax (and (equal? obj (quasiquote datum)) fender template)))
((_ obj (kar . kdr) fender template)
(syntax (and (pair? obj)
(let ((kar-obj (car obj)) (kdr-obj (cdr obj)))
(list-match-aux kar-obj kar
(list-match-aux kdr-obj kdr fender template))))))
((_ obj const fender template)
(syntax (and (equal? obj const) fender template))))))
R5RS Scheme does not provide any way to create new variable types or to combine multiple variables into a single unit; R6RS provides structures that perform these tasks. The structures given below are upward-compatible to R6RS structures. Calling
(define-structure name
...) creates a new structure.
Define-structure expands into a constructor
...), a type predicate
? obj
), and an accessor
) and setter
! x
) for an object x of structure type name.
(define-syntax (define-structure x)
(define (gen-id template-id . args)
(datum->syntax-object template-id
(apply string-append
(map (lambda (x)
(if (string? x) x
(syntax-object->datum x))))
(syntax-case x ()
((_ name field ...)
((constructor (gen-id (syntax name) "make-" (syntax name)))
(predicate (gen-id (syntax name) (syntax name) "?"))
((access ...)
(map (lambda (x) (gen-id x (syntax name) "-" x))
(syntax (field ...))))
((assign ...)
(map (lambda (x) (gen-id x "set-" (syntax name) "-" x "!"))
(syntax (field ...))))
(structure-length (+ (length (syntax (field ...))) 1))
((index ...) (let f ((i 1) (ids (syntax (field ...))))
(if (null? ids) '()
(cons i (f (+ i 1) (cdr ids)))))))
(syntax (begin
(define (constructor field ...)
(vector 'name field ...))
(define (predicate x)
(and (vector? x)
(= (vector-length x) structure-length)
(eq? (vector-ref x 0) 'name)))
(define (access x) (vector-ref x index)) ...
(define (assign x update) (vector-set! x index update))
Scheme provides one-dimensional arrays, which it calls vectors, but no two-dimensional arrays. Kent Dybvig provides a matrix data structure defined as a vector of vectors in The Scheme Programming Language:
(define (make-matrix rows columns . value)
(do ((m (make-vector rows)) (i 0 (+ i 1)))
((= i rows) m)
(if (null? value)
(vector-set! m i (make-vector columns))
(vector-set! m i (make-vector columns (car value))))))
(define (matrix-rows x) (vector-length x))
(define (matrix-cols x) (vector-length (vector-ref x 0)))
(define (matrix-ref m i j) (vector-ref (vector-ref m i) j))
(define (matrix-set! m i j x) (vector-set! (vector-ref m i) j x))
for macro is convenient for iterating over the rows and columns of a matrix. The syntax
(for (var
] past
]) body
...) binds var to first, then iterates var by step until it reaches past, which is not bound; the body statements are executed only for their side-effects. Step defaults to 1 if first is less than past and -1 otherwise; if first is also not given, it defaults to 0:
(define-syntax for
(syntax-rules ()
((for (var first past step) body ...)
(let ((ge? (if (= <=)))
(do ((var first (+ var step)))
((ge? var past))
body ...)))
((for (var first past) body ...)
(let* ((f first) (p past) (s (if (< first past) 1 -1)))
(for (var f p s) body ...)))
((for (var past) body ...)
(let* ((p past)) (for (var 0 p) body ...)))))
Hash Tables
Hash tables are one of the greatest inventions of computer science, permitting very fast retrieval of key/value pairs.
Make-hash creates an instance of an abstract data type of hash tables.
Make-hash takes four arguments:
Hash is a function that takes a key and returns an integer that provides an address for the bucket where the key/value pair is stored.
Eql? is a predicate that takes two keys and returns
#t if they are the same and
#f otherwise.
Oops is the default value returned by the hash table if a requested key is not present in the table.
Size is the number of buckets where key/value pairs are stored; it is best to choose
size as a prime number of magnitude similar to the expected number of key/value pairs.
Make-hash returns a function that, when called with an appropriate message, performs the requested action; for a hash table created by
(define state-tab (make-hash string-hash string=? #f 4093))
the appropriate call is
(state-tab 'message args ...)
where message and args can be any of the following:
insertkey value— inserts a key/value pair in the hash table, overwriting any previous value associated with the key
lookupkey — retrieves the value associated with key
deletekey — removes key and its associated value from the hash table, if it exists
updatekey proc default — proc is a function that takes a key and value as arguments and returns a new value; if key is present in the hash table,
updatecalls proc with the key and its associated value and stores the value returned by
procin place of the original value, otherwise
updateinserts a new key/value pair in the hash table with key key> and value default.
enlist— returns all the key/value pairs in the hash table as a list
Synonyms are provided for some of the messages; see the source code for details.
(define (make-hash hash eql? oops size)
(let ((table (make-vector size '())))
(lambda (message . args)
(if (eq? message 'enlist)
(let loop ((k 0) (result '()))
(if (= size k)
(loop (+ k 1) (append (vector-ref table k) result))))
(let* ((key (car args))
(index (modulo (hash key) size))
(bucket (vector-ref table index)))
(case message
((lookup fetch get ref recall)
(let loop ((bucket bucket))
(cond ((null? bucket) oops)
((eql? (caar bucket) key) (cdar bucket))
(else (loop (cdr bucket))))))
((insert insert! ins ins! set set! store store! install install!)
(vector-set! table index
(let loop ((bucket bucket))
(cond ((null? bucket)
(list (cons key (cadr args))))
((eql? (caar bucket) key)
(cons (cons key (cadr args)) (cdr bucket)))
(else (cons (car bucket) (loop (cdr bucket))))))))
((delete delete! del del! remove remove!)
(vector-set! table index
(let loop ((bucket bucket))
(cond ((null? bucket) '())
((eql? (caar bucket) key)
(cdr bucket))
(else (cons (car bucket) (loop (cdr bucket))))))))
((update update!)
(vector-set! table index
(let loop ((bucket bucket))
(cond ((null? bucket)
(list (cons key (caddr args))))
((eql? (caar bucket) key)
(cons (cons key ((cadr args) key (cdar bucket))) (cdr bucket)))
(else (cons (car bucket) (loop (cdr bucket))))))))
(else (error 'hash-table "unrecognized message")) ))))))
The most common data type used for hash-table keys is character strings, for which we provide this hash function:
(define (string-hash str)
(let loop ((cs (string->list str)) (s 0))
(if (null? cs) s
(loop (cdr cs) (+ (* s 31)
(char->integer (car cs)))))))
list->hash function returns a newly-allocated hash table containing each of the key/value pairs in the input list, where the key is the car of the item and the value is the cdr of the item:
(define (list->hash hash eql? oops size xs)
(let ((table (make-hash hash eql? oops size)))
(do ((xs xs (cdr xs))) ((null? xs) table)
(table 'insert (caar xs) (cdar xs)))))
Make-dict provides the abstract data type of an ordered map, sometimes called a dictionary. Unlike hash tables that only take an equality predicate, the dictionary takes a less-than predicate lt? so that it can iterate over its key/value pairs in order. The dictionary also provides order statistics, so you can select the nth key/value pair in order or find the ordinal rank of a given key. The implementation uses avl trees, so any access to a particular key/value pair takes time O(log n). A dictionary is created by:
(make-dict lt?) — returns a newly-allocated, empty dictionary that obeys the less-than lt? ordering predicate
A dictionary is represented by a function, and once it has been created, say by
(define dict (make-dict string<?)), operators are applied in message-passing style, such as
(dict 'message args
...) where messageand args can be any of the following:
empty?— returns
#tif the dictionary is empty, else
lookupkey ‐ returns a (key . value) pair corresponding to key, or
#fif key is not present in the dictionary [
insertkey value — returns a newly-allocated dictionary that includes all the key/value pairs in the input dictionary plus the input key and value, which replaces any existing key/value pair with a matching key; duplicate keys are not permitted [
updateproc key value) — returns a newly-allocated dictionary; if key is already present in the dictionary, the value associated with the key is replaced by
(prock v
), where k and v are the existing key and value; otherwise, the input key/value pair is added to the dictionary
deletekey — returns a newly-allocated dictionary in which key is not present, whether or not it is already present [
size— returns the number of key/value pairs in the dictionary [
nthn — returns the nth key/value pair in the dictionary, counting from zero
rankkey — returns the ordinal position of key in the dictionary, counting from zero
mapproc) — returns a newly-allocated dictionary in which each value is replaced by
(prock v
), where k and v are the existing key and value
foldproc base &mdsah; returns the value accumulated by applying the function
(prock v b
)to each key/value pair in the dictionary, accumulating the value of the base b at each step; pairs are accessed in order of ascending keys
for-eachproc — evaluates for its side-effects only
(prock v
)for each key/value pair in the dictionary in ascending order
to-list— returns a newly-allocated list of all the (key . value) pairs in the dictionary, in ascending order [
from-listxs — returns a newly-allocated dictionary that includes all the key/value pairs in the original dictionary plus all the (key . value) pairs in xs; any key in xs that already exists in the dictionary has its value replaced by the corresponding value in xs
make-gen— returns a function that, each time it is called, returns the next (key . value) pair from the dictionary, in ascending order; when the key/value pairs in the dictionary are exhausted, the function returns
#feach time it is called [
Synonyms are provided for some of the operations, as given in square brackets above.
(define-syntax define-generator
(lambda (x)
(syntax-case x (lambda)
((stx name (lambda formals e0 e1 ...))
(with-syntax ((yield (datum->syntax-object (syntax stx) 'yield)))
(syntax (define name
(lambda formals
(let ((resume #f) (return #f))
(define yield
(lambda args
(lambda (cont)
(set! resume cont)
(apply return args)))))
(lambda ()
(lambda (cont)
(set! return cont)
(cond (resume (resume))
(else (let () e0 e1 ...)
(error 'name "unexpected return"))))))))))))
((stx (name . formals) e0 e1 ...)
(syntax (stx name (lambda formals e0 e1 ...)))))))
(define (tree k v l r)
(vector k v l r (+ (max (ht l) (ht r)) 1)
(+ (size l) (size r) 1)))
(define (key t) (vector-ref t 0))
(define (val t) (vector-ref t 1))
(define (lkid t) (vector-ref t 2))
(define (rkid t) (vector-ref t 3))
(define (ht t) (vector-ref t 4))
(define (size t) (vector-ref t 5))
(define (bal t) (- (ht (lkid t)) (ht (rkid t))))
(define nil (vector 'nil 'nil 'nil 'nil 0 0))
(define (nil? t) (eq? t nil))
(define (rot-left t)
(if (nil? t) t
(tree (key (rkid t))
(val (rkid t))
(tree (key t) (val t) (lkid t) (lkid (rkid t)))
(rkid (rkid t)))))
(define (rot-right t)
(if (nil? t) t
(tree (key (lkid t))
(val (lkid t))
(lkid (lkid t))
(tree (key t) (val t) (rkid (lkid t)) (rkid t)))))
(define (balance t)
(let ((b (bal t)))
(cond ((< (abs b) 2) t)
((positive? b)
(if (< -1 (bal (lkid t))) (rot-right t)
(rot-right (tree (key t) (val t)
(rot-left (lkid t)) (rkid t)))))
((negative? b)
(if (< (bal (rkid t)) 1) (rot-left t)
(rot-left (tree (key t) (val t)
(lkid t) (rot-right (rkid t)))))))))
(define (lookup t k)
(cond ((nil? t) #f)
((lt? k (key t)) (lookup (lkid t) k))
((lt? (key t) k) (lookup (rkid t) k))
(else (cons k (val t)))))
(define (insert t k v)
(cond ((nil? t) (tree k v nil nil))
((lt? k (key t))
(balance (tree (key t) (val t)
(insert (lkid t) k v) (rkid t))))
((lt? (key t) k)
(balance (tree (key t) (val t)
(lkid t) (insert (rkid t) k v))))
(else (tree k v (lkid t) (rkid t)))))
(define (update t f k v)
(cond ((nil? t) (tree k v nil nil))
((lt? k (key t))
(balance (tree (key t) (val t)
(update (lkid t) f k v) (rkid t))))
((lt? (key t) k)
(balance (tree (key t) (val t)
(lkid t) (update (rkid t) f k v))))
(else (tree k (f k (val t)) (lkid t) (rkid t)))))
(define (delete-successor t)
(if (nil? (lkid t)) (values (rkid t) (key t) (val t))
(lambda () (delete-successor (lkid t)))
(lambda (l k v)
(values (balance (tree (key t) (val t) l (rkid t))) k v)))))
(define (delete t k)
(cond ((nil? t) nil)
((lt? k (key t))
(balance (tree (key t) (val t)
(delete (lkid t) k) (rkid t))))
((lt? (key t) k)
(balance (tree (key t) (val t)
(lkid t) (delete (rkid t) k))))
((nil? (lkid t)) (rkid t))
((nil? (rkid t)) (lkid t))
(else (call-with-values
(lambda () (delete-successor (rkid t)))
(lambda (r k v) (balance (tree k v (lkid t) r)))))))
(define (nth t n)
(if (negative? n) (error 'nth "must be non-negative")
(let ((s (size (lkid t))))
(cond ((< n s) (nth (lkid t) n))
((< s n) (nth (rkid t) (- n s 1)))
((nil? t) #f)
(else (cons (key t) (val t)))))))
(define (rank t k)
(let loop ((t t) (s (size (lkid t))))
(cond ((nil? t) #f)
((lt? k (key t))
(loop (lkid t) (- s (size (rkid (lkid t))) 1)))
((lt? (key t) k)
(loop (rkid t) (+ s (size (lkid (rkid t))) 1)))
(else s))))
(define (avl-map proc t) ; (proc key value)
(if (nil? t) nil
(tree (key t) (proc (key t) (val t))
(avl-map proc (lkid t))
(avl-map proc (rkid t)))))
(define (avl-fold proc base t) ; (proc key value base)
(if (nil? t) base
(avl-fold proc
(proc (key t) (val t)
(avl-fold proc base (lkid t)))
(rkid t))))
(define (avl-for-each proc t) ; (proc key value)
(unless (nil? t)
(avl-for-each proc (lkid t))
(proc (key t) (val t))
(avl-for-each proc (rkid t))))
(define (to-list t)
(cond ((nil? t) (list))
((and (nil? (lkid t)) (nil? (rkid t)))
(list (cons (key t) (val t))))
(else (append (to-list (lkid t))
(list (cons (key t) (val t)))
(to-list (rkid t))))))
(define (from-list t xs)
(let loop ((xs xs) (t t))
(if (null? xs) t
(loop (cdr xs) (insert t (caar xs) (cdar xs))))))
(define-generator (make-gen t)
(avl-for-each (lambda (k v) (yield (cons k v))) t)
(do () (#f) (yield #f)))
(define (new dict)
(lambda (message . args) (dispatch dict message args)))
(define (dispatch dict message args)
(define (arity n)
(if (not (= (length args) n)) (error 'dict "incorrect arity")))
(case message
((empty? nil?) (arity 0) (nil? dict))
((lookup fetch get) (arity 1) (apply lookup dict args))
((insert store put) (arity 2) (new (apply insert dict args)))
((update) (arity 3) (new (apply update dict args)))
((delete remove) (arity 1) (new (apply delete dict args)))
((size count length) (arity 0) (size dict))
((nth) (arity 1) (apply nth dict args))
((rank) (arity 1) (apply rank dict args))
((map) (arity 1) (new (avl-map (car args) dict)))
((fold) (arity 2) (avl-fold (car args) (cadr args) dict))
((for-each) (arity 1) (avl-for-each (car args) dict))
((to-list enlist) (arity 0) (to-list dict))
((from-list) (arity 1) (new (apply from-list dict args)))
((make-gen gen) (arity 0) (make-gen dict))
(else (error 'dict "invalid message"))))
(vector-set! nil 2 nil) (vector-set! nil 3 nil) (new nil))
Read-file returns a list of the characters in a file:
(define (read-file file-name)
(with-input-from-file file-name (lambda ()
(let loop ((c (read-char)) (cs '()))
(if (eof-object? c) (reverse cs)
(loop (read-char) (cons c cs)))))))
The three input processors
map-input and
fold-input operate on an input file or port in a manner similar to the way
map and
fold-left operate on lists. All three take an optional final argument. If the final argument is missing, input is taken from the current input port; as a side effect, all characters on the port are exhausted. If the final argument is a port, input is taken from the port, which is left open when the function returns; as a side effect, all characters on the port are exhausted. If the final argument is a string, it is taken as the name of a file which is opened, used as the source of input, and closed before the function returns. For all three functions, reader is a function that returns the next item from the input, and proc is a function that operates on each item.
(define (for-each-input reader proc . pof)
(let* ((f? (and (pair? pof) (string? (car pof))))
(p (cond (f? (open-input-file (car pof)))
((pair? pof) (car pof))
(else (current-input-port)))))
(do ((item (reader p) (reader p)))
((eof-object? item)
(if f? (close-input-port p)))
(proc item))))
(define (map-input reader proc . pof)
(let* ((f? (and (pair? pof) (string? (car pof))))
(p (cond (f? (open-input-file (car pof)))
((pair? pof) (car pof))
(else (current-input-port)))))
(let loop ((item (reader p)) (result '()))
(if (eof-object? item)
(begin (if f? (close-input-port p)) (reverse result))
(loop (reader p) (cons (proc item) result))))))
(define (fold-input reader proc base . pof)
(let* ((f? (and (pair? pof) (string? (car pof))))
(p (cond (f? (open-input-file (car pof)))
((pair? pof) (car pof))
(else (current-input-port)))))
(let loop ((item (reader p)) (base base))
(if (eof-object? item)
(begin (if f? (close-input-port p)) base)
(loop (reader p) (proc base item))))))
Read-line reads the next line of text from a named port or, if none is given, from the current input port. A line is a maximal sequence of characters terminated by a newline, a carriage return, or both characters in either order; the final line in a file need not be terminated.
(define (read-line . port)
(define (eat p c)
(if (and (not (eof-object? (peek-char p)))
(char=? (peek-char p) c))
(read-char p)))
(let ((p (if (null? port) (current-input-port) (car port))))
(let loop ((c (read-char p)) (line '()))
(cond ((eof-object? c) (if (null? line) c (list->string (reverse line))))
((char=? #\newline c) (eat p #\return) (list->string (reverse line)))
((char=? #\return c) (eat p #\newline) (list->string (reverse line)))
(else (loop (read-char p) (cons c line)))))))
Filter-input is a combinator that takes a reader function and a predicate and returns a new reader function that only passes input items x for which
) is non-
(define (filter-input reader pred?)
(lambda args
(let loop ((item (apply reader args)))
(if (or (eof-object? item) (pred? item)) item
(loop (apply reader args))))))
(String-index c
) returns the zero-based index of the first occurrence of c in str, or
#f if c does not appear in str:
(define (string-index c str)
(let loop ((ss (string->list str)) (k 0))
(cond ((null? ss) #f)
((char=? (car ss) c) k)
(else (loop (cdr ss) (+ k 1))))))
Case conversions are handled by
string-downcase and
(define (string-downcase str)
(map char-downcase
(string->list str))))
(define (string-upcase str)
(map char-upcase
(string->list str))))
String-split takes a separator character and a string and returns a list of sub-strings bounded by the separator character.
String-join is the inverse.
(define (string-split sep str)
(define (f cs xs) (cons (list->string (reverse cs)) xs))
(let loop ((ss (string->list str)) (cs '()) (xs '()))
(cond ((null? ss) (reverse (if (null? cs) xs (f cs xs))))
((char=? (car ss) sep) (loop (cdr ss) '() (f cs xs)))
(else (loop (cdr ss) (cons (car ss) cs) xs)))))
(define (string-join sep ss)
(define (f s ss)
(string-append s (string sep) ss))
(define (join ss)
(if (null? (cdr ss)) (car ss)
(f (car ss) (join (cdr ss)))))
(if (null? ss) "" (join ss)))
String-find returns the starting position of a pattern in a string, or
#f if the string does not contain the pattern; it uses the Knuth-Morris-Pratt string search algorithm:
(define (string-find pat str . s)
(let* ((plen (string-length pat))
(slen (string-length str))
(skip (make-vector plen 0)))
(let loop ((i 1) (j 0))
(cond ((= i plen))
((char=? (string-ref pat i) (string-ref pat j))
(vector-set! skip i (+ j 1))
(loop (+ i 1) (+ j 1)))
((< 0 j) (loop i (vector-ref skip (- j 1))))
(else (vector-set! skip i 0)
(loop (+ i 1) j))))
(let loop ((p 0) (s (if (null? s) 0 (car s))))
(cond ((= s slen) #f)
((char=? (string-ref pat p) (string-ref str s))
(if (= p (- plen 1))
(- s plen -1)
(loop (+ p 1) (+ s 1))))
((< 0 p) (loop (vector-ref skip (- p 1)) s))
(else (loop p (+ s 1)))))))
Most Scheme systems provide a sort function, and it is required in R6RS. For those that don't, we provide this
sort, which is stolen from Kent Dybvig's book The Scheme Programming Language; it is stable, applicative, miserly about garbage generation, and fast, and it also provides a
merge function. Lt? is a predicate that takes two elements of xs and returns
#t if the first precedes the second and
#f otherwise:
(define sort #f)
(define merge #f)
(let ()
(define dosort
(lambda (pred? ls n)
(if (= n 1)
(list (car ls))
(let ((i (quotient n 2)))
(domerge pred?
(dosort pred? ls i)
(dosort pred? (list-tail ls i) (- n i)))))))
(define domerge
(lambda (pred? l1 l2)
((null? l1) l2)
((null? l2) l1)
((pred? (car l2) (car l1))
(cons (car l2) (domerge pred? l1 (cdr l2))))
(else (cons (car l1) (domerge pred? (cdr l1) l2))))))
(set! sort
(lambda (pred? l)
(if (null? l) l (dosort pred? l (length l)))))
(set! merge
(lambda (pred? l1 l2)
(domerge pred? l1 l2))))
Like its unix counterpart,
unique returns its input list with adjacent duplicates removed.
Uniq-c returns its input list paired with a count of adjacent duplicates, just like unix
uniq with the
-c flag.
(define (unique eql? xs)
(cond ((null? xs) '())
((null? (cdr xs)) xs)
((eql? (car xs) (cadr xs))
(unique eql? (cdr xs)))
(else (cons (car xs) (unique eql? (cdr xs))))))
(define (uniq-c eql? xs)
(if (null? xs) xs
(let loop ((xs (cdr xs)) (prev (car xs)) (k 1) (result '()))
(cond ((null? xs) (reverse (cons (cons prev k) result)))
((eql? (car xs) prev) (loop (cdr xs) prev (+ k 1) result))
(else (loop (cdr xs) (car xs) 1 (cons (cons prev k) result)))))))
Vectors are sorted with the Bentley/McIlroy quicksort. The comparison function
(cmp a
) returns an integer that is less than, equal to, or greater than zero when its first argument is less than, equal to, or greater than its second.
(define (vector-sort! vec comp)
(define-syntax while
(syntax-rules ()
((while pred? body ...)
(do () ((not pred?)) body ...))))
(define-syntax assign!
(syntax-rules ()
((assign! var expr)
(begin (set! var expr) var))))
(define len (vector-length vec))
(define-syntax v (syntax-rules () ((v k) (vector-ref vec k))))
(define-syntax v! (syntax-rules () ((v! k x) (vector-set! vec k x))))
(define-syntax cmp (syntax-rules () ((cmp a b) (comp (v a) (v b)))))
(define-syntax lt? (syntax-rules () ((lt? a b) (negative? (cmp a b)))))
(define-syntax swap! (syntax-rules () ((swap! a b)
(let ((t (v a))) (v! a (v b)) (v! b t)))))
(define (vecswap! a b s)
(do ((a a (+ a 1)) (b b (+ b 1)) (s s (- s 1))) ((zero? s))
(swap! a b)))
(define (med3 a b c)
(if (lt? b c)
(if (lt? b a) (if (lt? c a) c a) b)
(if (lt? c a) (if (lt? b a) b a) c)))
(define (pv-init a n)
(let ((pm (+ a (quotient n 2))))
(when (> n 7)
(let ((pl a) (pn (+ a n -1)))
(when (> n 40)
(let ((s (quotient n 8)))
(set! pl (med3 pl (+ pl s) (+ pl s s)))
(set! pm (med3 (- pm s) pm (+ pm s)))
(set! pn (med3 (- pn s s) (- pn s) pn))))
(set! pm (med3 pl pm pn))))
(let qsort ((a 0) (n len))
(if (< n 7)
(do ((pm (+ a 1) (+ pm 1))) ((not ( pl a) (> (cmp (- pl 1) pl) 0))))
(swap! pl (- pl 1))))
(let ((pv (pv-init a n)) (r #f)
(pa a) (pb a) (pc (+ a n -1)) (pd (+ a n -1)))
(swap! a pv) (set! pv a)
(let loop ()
(while (and (<= pb pc) (= pc pb) (>= (assign! r (cmp pc pv)) 0))
(when (= r 0) (swap! pc pd) (set! pd (- pd 1)))
(set! pc (- pc 1)))
(unless (> pb pc)
(swap! pb pc) (set! pb (+ pb 1)) (set! pc (- pc 1)) (loop)))
(let ((pn (+ a n)))
(let ((s (min (- pa a) (- pb pa)))) (vecswap! a (- pb s) s))
(let ((s (min (- pd pc) (- pn pd 1)))) (vecswap! pb (- pn s) s))
(let ((s (- pb pa))) (when (> s 1) (qsort a s)))
(let ((s (- pd pc))) (when (> s 1) (qsort (- pn s) s))))))))
Higher-Order Functions
Identity returns it only argument and
constant returns a function that, when called, always returns the same value regardless of its argument. Both functions are useful as recursive bases when writing higher-order functions.
(define (constant x) (lambda ys x))
Fst returns it first argument and
snd returns its second argument; both functions occasionally find use when composing strings of functions:
Function composition creates a new function by partially applying multiple functions, one after the other. In the simplest case, there are only two functions,
f and
g, composed as
((compose f g) x) ≡ (f (g x)); the composition can be bound to create a new function, as in
(define fg (compose f g)).
Compose takes one or more procedures and returns a new procedure that performs the same action as the individual procedures would if called in succession.
(define (compose . fns)
(let comp ((fns fns))
((null? fns) 'error)
((null? (cdr fns)) (car fns))
(lambda args
(lambda ()
(comp (cdr fns))
(car fns)))))))
Complement takes a predicate and returns a new predicate that returns
#t where the original returned
#f and
#f where the original returned non-
#f. It is useful with functions like
filter and
take-while that take predicates as arguments.
(define (complement f) (lambda xs (not (apply f xs))))
Swap takes a binary function and returns a new function that is similar to the original but with arguments reversed. It is useful when composing or currying functions that take their arguments in an inconvenient order.
(define (swap f) (lambda (x y) (f y x)))
A section is a procedure which has been partially applied to some of its arguments; for instance,
(double x), which returns twice its argument, is a partial application of the multiply operator to the number 2. Sections come in two kinds: left sections partially apply arguments starting from the left, and right sections partially apply arguments starting from the right.
Left-section takes a procedure and some prefix of its arguments and returns a new procedure in which those arguments are partially applied.
Right-section takes a procedure and some reversed suffix of its arguments and returns a new procedure in which those arguments are partially applied.
(define (left-section proc . args)
(lambda xs (apply proc (append args xs))))
(define (right-section proc . args)
(lambda xs (apply proc (reverse (append (reverse args) (reverse xs))))))
Currying is the technique of rewriting a function that takes multiple arguments so that it can be called as a chain of functions that each take a single argument; the technique is named after the mathematician Haskell Curry, who discovered it (Moses Schönfinkel discovered the technique independently, but the term schönfinkeling never caught on). For example, if
div is the curried form of the division operator, defined as
(define-curried (div x y) (/ x y)), then
inv is the function that returns the inverse of its argument, defined as
(define inv (div 1)).
(define-syntax curried-lambda
(syntax-rules ()
((_ () body body* ...)
(begin body body* ...))
((_ (arg arg* ...) body body* ...)
(lambda (arg)
(curried-lambda (arg* ...)
body body* ...)))))
(define-syntax define-curried
(syntax-rules ()
((_ (func arg ...) body body* ...)
(define func
(curried-lambda (arg ...)
body body* ...)))))
Math Functions
The powering function
(ipow b
) raises a base b to an integer power e; e must be non-negative:
(define (ipow b e)
(if (= e 0) 1
(let loop ((s b) (i e) (a 1)) ; a * s^i = b^e
(let ((a (if (odd? i) (* a s) a)) (i (quotient i 2)))
(if (zero? i) a (loop (* s s) i a))))))
The integer square root of a positive number is the greatest integer that, when multiplied by itself, does not exceed the given number. The integer square root can be computed by Newton's method of approximation via derivatives:
(define (isqrt n)
(if (not (and (positive? n) (integer? n)))
(error 'isqrt "must be positive integer")
(let loop ((x n))
(let ((y (quotient (+ x (quotient n x)) 2)))
(if (< y x) (loop y) x)))))
The integer logarithm base b of a number n is the number of times the number b can be multiplied by itself without exceeding n:
(define (ilog b n)
(let loop1 ((lo 0) (b^lo 1) (hi 1) (b^hi b))
(if (< b^hi n) (loop1 hi b^hi (* hi 2) (* b^hi b^hi))
(let loop2 ((lo lo) (b^lo b^lo) (hi hi) (b^hi b^hi))
(if (<= (- hi lo) 1) (if (= b^hi n) hi lo)
(let* ((mid (quotient (+ lo hi) 2))
(b^mid (* b^lo (expt b (- mid lo)))))
(cond ((< n b^mid) (loop2 lo b^lo mid b^mid))
((< b^mid n) (loop2 mid b^mid hi b^hi))
(else mid))))))))
Modular exponentiation is provided by the function
(expm b
). This is equivalent to
(modulo (expt b
) m
), except that the algorithm avoids the calculation of the large intermediate exponentiation by performing multiply-and-square in stages.
(define (expm b e m)
(define (m* x y) (modulo (* x y) m))
(cond ((zero? e) 1)
((even? e) (expm (m* b b) (/ e 2) m))
(else (m* b (expm (m* b b) (/ (- e 1) 2) m)))))
log2 and
log10 are convenient, especially as the function in a
(define (log2 x) (/ (log x) (log 2)))
(define (log10 x) (/ (log x) (log 10)))
It is sometimes necessary to extract the digits of a number, to varying bases. Here are functions that convert a number to its digits, and the converse:
(define (digits n . args)
(let ((b (if (null? args) 10 (car args))))
(let loop ((n n) (d '()))
(if (zero? n) d
(loop (quotient n b)
(cons (modulo n b) d))))))
(define (undigits ds . args)
(let ((b (if (null? args) 10 (car args))))
(let loop ((ds ds) (n 0))
(if (null? ds) n
(loop (cdr ds) (+ (* n b) (car ds)))))))
Common Lisp provides a full suite of bit operators and a bit vector sequence datatype. Scheme, in its minimalism, provided neither until R6RS required a minimal suite of bit operators, but still no bit vectors. Our suite is small but useful. Note that all the bit functions are grossly inefficient; you should use whatever your Scheme implementation provides instead of relying on the functions given below.
Bit-wise operators consider numbers as a sequence of binary bits and operate on them using the logical operations and, inclusive-or, exclusive-or, and not; they are implemented using basic arithmetic. An arithmetic shift multiplies (positive shift) or divides (negative shift) by powers of two:
(define (logand a b)
(if (or (zero? a) (zero? b)) 0
(+ (* (logand (floor (/ a 2)) (floor (/ b 2))) 2)
(if (or (even? a) (even? b)) 0 1))))
(define (logior x y)
(cond ((= x y) x)
((zero? x) y)
((zero? y) x)
(+ (* (logior (quotient x 2) (quotient y 2)) 2)
(if (and (even? x) (even? y)) 0 1)))))
(define (logxor a b)
(cond ((zero? a) b)
((zero? b) a)
(+ (* (logxor (floor (/ a 2)) (floor (/ b 2))) 2)
(if (even? a)
(if (even? b) 0 1)
(if (even? b) 1 0))))))
(define (ash int cnt)
(if (negative? cnt)
(let ((n (expt 2 (- cnt))))
(if (negative? int)
(+ -1 (quotient (+ 1 int) n))
(quotient int n)))
(* (expt 2 cnt) int)))
Bit vectors are implemented using arrays of characters. They are represented as a pair with a vector of eight-bit characters in the car and the length of the bit vector in the cdr.
Make-bitvector creates a bit vector of the requested length with all bits zero unless the optional argument val is one; note the logic to ensure any "slop" bits at the end of the bit vector are set to zero, which is useful in the
bitvector-count function:
(define (make-bitvector len . val)
(let ((v (make-vector
(ceiling (/ len 8))
(if (and (pair? val) (= (car val) 1)) 255 0))))
(if (and (pair? val) (= (car val) 1) (not (zero? (modulo len 8))))
(do ((i 8 (- i 1))) ((= i (modulo len 8)))
(vector-set! v (floor (/ len 8))
(logand (vector-ref v (floor (/ len 8))) (lognot (ash 1 (- i 1)))))))
(cons v len)))
Bitvector-ref returns the value of
bv[idx], either zero or one:
(define (bitvector-ref bv idx)
(if (< -1 idx (cdr bv))
(let ((index (quotient idx 8)) (offset (modulo idx 8)))
(if (odd? (ash (vector-ref (car bv) index) (- offset))) 1 0))
(error 'bitvector-ref "out of range")))
Bitvector-set! sets the requested bit to one.
Bitvector-reset! sets the requested bit to zero:
(define (bitvector-set! bv idx)
(if (< -1 idx (cdr bv))
(let ((index (quotient idx 8)) (offset (modulo idx 8)))
(vector-set! (car bv) index
(logior (vector-ref (car bv) index) (ash 1 offset))))
(error 'bitvector-set! "out of range")))
(define (bitvector-reset! bv idx)
(if (< -1 idx (cdr bv))
(let ((index (quotient idx 8)) (offset (modulo idx 8)))
(vector-set! (car bv) index
(logand (vector-ref (car bv) index) (lognot (ash 1 offset)))))
(error 'bitvector-reset! "out of range")))
Bitvector-count returns the number of one-bits in the input bit vector. The counts per byte are pre-calculated in the
counts vector. Note that the last byte is not special, because
make-bitvector was careful to ensure that any "slop" bits are zero:
(define (bitvector-count bv)
(let* ((counts #(
0 1 1 2 1 2 2 3 1 2 2 3 2 3 3 4 1 2 2 3 2 3 3 4 2 3 3 4 3 4 4 5
1 2 2 3 2 3 3 4 2 3 3 4 3 4 4 5 2 3 3 4 3 4 4 5 3 4 4 5 4 5 5 6
1 2 2 3 2 3 3 4 2 3 3 4 3 4 4 5 2 3 3 4 3 4 4 5 3 4 4 5 4 5 5 6
2 3 3 4 3 4 4 5 3 4 4 5 4 5 5 6 3 4 4 5 4 5 5 6 4 5 5 6 5 6 6 7
1 2 2 3 2 3 3 4 2 3 3 4 3 4 4 5 2 3 3 4 3 4 4 5 3 4 4 5 4 5 5 6
2 3 3 4 3 4 4 5 3 4 4 5 4 5 5 6 3 4 4 5 4 5 5 6 4 5 5 6 5 6 6 7
2 3 3 4 3 4 4 5 3 4 4 5 4 5 5 6 3 4 4 5 4 5 5 6 4 5 5 6 5 6 6 7
3 4 4 5 4 5 5 6 4 5 5 6 5 6 6 7 4 5 5 6 5 6 6 7 5 6 6 7 6 7 7 8))
(len (cdr bv)) (index (quotient len 8)) (offset (modulo len 8)))
(do ((i 0 (+ i 1))
(count 0 (+ count (vector-ref counts (vector-ref (car bv) i)))))
((= index i) count))))
Bitvector-length returns the number of bits in the bit vector:
(define (bitvector-length bv) (cdr bv))
Random Numbers
This is the portable, high-quality random number generator provided in the Stanford GraphBase by Donald E. Knuth. Based on the lagged fibonacci generator (Knuth calls it the subtractive method)an = (an-24 − an-55) mod m, where m is an even number (we take m = 231) and the numbers a0 through a54 are not all even, it provides values on the range zero inclusive to 231 exclusive, has a period of at least 255 − 1 but is plausibly conjectured to have a period of 285 − 230 for all but at most one choice of the seed value, and the low-order bits of the generated numbers are just as random as the high-order bits. You can read Knuth's original version of the random number generator at http://tex.loria.fr/sgb/gb_flip.pdf; see also our exercise GB_FLIP. This random number generator is suitable for simulation but is not cryptographically secure.
Called with no arguments,
(rand) returns an exact rational number on the range zero inclusive to one exclusive. Called with a single numeric argument,
(rand seed
) resets the seed of the random number generator; it is best if the seed is a large integer (eight to ten digits — dates in the form YYYYMMDD work well), though seeds like 0.3 (three-tenths of 2^35) and -42 (2^35-42) also work. Since the shuffling algorithm requires its own data store, knowing the current seed is not sufficient to restart the generator. Thus,
(rand 'get) returns the complete current state of the generator, and
(rand 'set state
) resets the generator to the given state, given a state in the form provided by
(rand 'get). (randint n) returns a random non-negative integer less than n and (randint first past) returns a random integer between first inclusive and past exclusive.
Two versions of the
mod-diff function are included. You should use the fast version if your Scheme provides
logand natively, or the generic version otherwise. Note that
logand is sometimes provided under a different name; for instance, it is
bitwise-and in R6RS.
(define rand #f)
(define randint #f)
(let ((two31 #x80000000) (a (make-vector 56 -1)) (fptr #f))
(define (mod-diff x y) (modulo (- x y) two31)) ; generic version
; (define (mod-diff x y) (logand (- x y) #x7FFFFFFF)) ; fast version
(define (flip-cycle)
(do ((ii 1 (+ ii 1)) (jj 32 (+ jj 1))) ((< 55 jj))
(vector-set! a ii (mod-diff (vector-ref a ii) (vector-ref a jj))))
(do ((ii 25 (+ ii 1)) (jj 1 (+ jj 1))) ((< 55 ii))
(vector-set! a ii (mod-diff (vector-ref a ii) (vector-ref a jj))))
(set! fptr 54) (vector-ref a 55))
(define (init-rand seed)
(let* ((seed (mod-diff seed 0)) (prev seed) (next 1))
(vector-set! a 55 prev)
(do ((i 21 (modulo (+ i 21) 55))) ((zero? i))
(vector-set! a i next) (set! next (mod-diff prev next))
(set! seed (+ (quotient seed 2) (if (odd? seed) #x40000000 0)))
(set! next (mod-diff next seed)) (set! prev (vector-ref a i)))
(flip-cycle) (flip-cycle) (flip-cycle) (flip-cycle) (flip-cycle)))
(define (next-rand)
(if (negative? (vector-ref a fptr)) (flip-cycle)
(let ((next (vector-ref a fptr))) (set! fptr (- fptr 1)) next)))
(define (unif-rand m)
(let ((t (- two31 (modulo two31 m))))
(let loop ((r (next-rand)))
(if (list a)))
((eq? (car seed) 'set) (set! fptr (caadr seed))
(set! a (list->vector (cdadr seed))))
(else (/ (init-rand (modulo (numerator
(inexact->exact (car seed))) two31)) two31)))))
(set! randint (lambda args
(cond ((null? (cdr args))
(if (< (car args) two31) (unif-rand (car args))
(floor (* (next-rand) (car args)))))
((< (car args) (cadr args))
(let ((span (- (cadr args) (car args))))
(+ (car args)
(if (< span two31) (unif-rand span)
(floor (* (next-rand) span))))))
(else (let ((span (- (car args) (cadr args))))
(- (car args)
(if (< span two31) (unif-rand span)
(floor (* (next-rand) span))))))))))
Fortune selects an item randomly from a list; the first item is selected with probability 1/1, the second item replaces the selection with probability 1/2, the third item replaces that selection with probability 1/3, and so on, so that the kth item is selected with probability 1/k. The name derives from the unix game of the same name, which selects an epigram randomly from a file containing one per line.
(define (fortune xs)
(let loop ((n 1) (x #f) (xs xs))
(cond ((null? xs) x)
((< (rand) (/ n))
(loop (+ n 1) (car xs) (cdr xs)))
(else (loop (+ n 1) x (cdr xs))))))
shuffle a list, convert it to a vector, shuffle the vector by Knuth's algorithm, and convert the result back to a list:
(define (shuffle x)
(do ((v (list->vector x)) (n (length x) (- n 1)))
((zero? n) (vector->list v))
(let* ((r (randint n)) (t (vector-ref v r)))
(vector-set! v r (vector-ref v (- n 1)))
(vector-set! v (- n 1) t))))
Control Flow
Rather than writing one-armed
ifs, it is generally better to use a
when or
unless, which declares precisely what it is.
When and
unless are provided natively by many Scheme systems; for those that don't, they are given below:
(define-syntax when
(syntax-rules ()
((when pred? expr ...)
(if pred? (begin expr ...)))))
(define-syntax unless
(syntax-rules ()
((unless pred? expr ...)
(if (not pred?) (begin expr ...)))))
While performs a block of code as long as the controlling predicate is true:
(define-syntax while
(syntax-rules ()
((while pred? body ...)
(do () ((not pred?)) body ...))))
call-with-values syntax makes it difficult to use multiple values. The
let-values syntax required by R6RS and present in many R5RS systems is far more convenient. An implementation, stolen from Kent Dybvig, is given below for those Scheme systems that lack
(define-syntax let-values
(syntax-rules ()
((_ () f1 f2 ...) (let () f1 f2 ...))
((_ ((fmls1 expr1) (fmls2 expr2) ...) f1 f2 ...)
(let-values-help fmls1 () () expr1 ((fmls2 expr2) ...) (f1 f2 ...)))))
(define-syntax let-values-help
(syntax-rules ()
((_ (x1 . fmls) (x ...) (t ...) e m b)
(let-values-help fmls (x ... x1) (t ... tmp) e m b))
((_ () (x ...) (t ...) e m b)
(lambda () e)
(lambda (t ...)
(let-values m (let ((x t) ...) . b)))))
((_ xr (x ...) (t ...) e m b)
(lambda () e)
(lambda (t ... . tmpr)
(let-values m (let ((x t) ... (xr tmpr)) . b)))))))
Generators provide an easy-to-use syntax for separating the production of values from their consumption, and are provided natively in many other languages (sometimes they are called iterators). A function defined by
define-generator creates a function that, when called, returns the next value in a sequence. For instance:
> (define-generator (yield123)
(yield 1) (yield 2) (yield 3))
> (define y (yield123))
> (y)
> (y)
> (y)
> (y)
Exception in yield123: unexpected return
Define-generator is given below:
(define-syntax define-generator
(lambda (x)
(syntax-case x (lambda)
((stx name (lambda formals e0 e1 ...))
(with-syntax ((yield (datum->syntax (syntax stx) 'yield)))
(syntax (define name
(lambda formals
(let ((resume #f) (return #f))
(define yield
(lambda args
(lambda (cont)
(set! resume cont)
(apply return args)))))
(lambda ()
(lambda (cont)
(set! return cont)
(cond (resume (resume))
(else (let () e0 e1 ...)
(error 'name "unexpected return"))))))))))))
((stx (name . formals) e0 e1 ...)
(syntax (stx name (lambda formals e0 e1 ...)))))))
Date Arithmetic
Astronomers calculate the julian number of a date as the number of days elapsed since January 1, 4713 BC. The Gregorian calendar, promulgated by Pope Gregory XIII on February 24, 1582, is the civil calendar used in much of the world. Functions
julian and
gregorian translate between the two calendars; year must be specified as the full four-digit number (unless you want years in the first millenium), month ranges from 1 for January to 12 for December, day ranges from 1 to 31, and the day of the week can be calculated as the julian number modulo 7, with 0 for Monday and 6 for Sunday:
(define (julian year month day)
(let* ((a (quotient (- 14 month) 12))
(y (+ year 4800 (- a)))
(m (+ month (* 12 a) -3)))
(+ day
(quotient (+ (* 153 m) 2) 5)
(* 365 y)
(quotient y 4)
(- (quotient y 100))
(quotient y 400)
(- 32045))))
(define (gregorian julian)
(let* ((j (+ julian 32044))
(g (quotient j 146097))
(dg (modulo j 146097))
(c (quotient (* (+ (quotient dg 36524) 1) 3) 4))
(dc (- dg (* c 36524)))
(b (quotient dc 1461))
(db (modulo dc 1461))
(a (quotient (* (+ (quotient db 365) 1) 3) 4))
(da (- db (* a 365)))
(y (+ (* g 400) (* c 100) (* b 4) a))
(m (- (quotient (+ (* da 5) 308) 153) 2))
(d (+ da (- (quotient (* (+ m 4) 153) 5)) 122))
(year (+ y (- 4800) (quotient (+ m 2) 12)))
(month (+ (modulo (+ m 2) 12) 1))
(day (+ d 1)))
(values year month day)))
For several centuries, the calculation of the date of Easter, a calculation known as the computus, was the most important scientific endeavor of the entire world. Function
easter calculates the julian number of the date of Easter for a given year. If
offset is given, it is the number of days before or after Easter; for instance, to compute the date of Mardi Gras, give an
offset of -47:
(define (easter year . offset)
(let* ((a (modulo year 19))
(b (quotient year 100))
(c (modulo year 100))
(d (quotient b 4))
(e (modulo b 4))
(f (quotient (+ b 8) 25))
(g (quotient (+ (- b f) 1) 3))
(h (modulo (- (+ (* 19 a) b 15) d g) 30))
(i (quotient c 4))
(k (modulo c 4))
(l (modulo (- (+ 32 (* 2 e) (* 2 i)) h k) 7))
(m (quotient (+ a (* 11 h) (* 22 l)) 451))
(month (quotient (- (+ h l 114) (* 7 m)) 31))
(day (+ (modulo (- (+ h l 114) (* 7 m)) 31) 1))
(q (if (pair? offset) (car offset) 0)))
(+ (julian year month day) q)))
Calculating the current date requires help from the local Scheme interpreter, since Scheme defines no standard functions on dates. Shown below are versions for two popular Scheme interpreters:
(define (today) ; Chez Scheme
(date-year (current-date))
(+ (date-month (current-date)) 1)
(date-day (current-date))))
(define (today) ; MzScheme
(let ((today (seconds->date (current-seconds))))
(julian (date-year today) (date-month today) (date-day today))))
Unit Testing
assert macro is useful when testing programs. The syntax
(assert expr
) computes expr and result; if they are the same, assert produces no output and returns no value. But if expr and result differ,
assert writes a message that includes the text of expr and the result of computing both expr and result.
Assert is a macro, not a function, because it prints the literal expr as part of its output, making it easy in a long sequence of assertions to know which is in error.
Assert produces no output if all is well, on the theory that "No news is good news."
(define-syntax assert
(syntax-rules ()
((assert expr result)
(if (not (equal? expr result))
(for-each display `(
#\newline "failed assertion:" #\newline
expr #\newline "expected: " ,result
#\newline "returned: " ,expr #\newline))))))
Define-integrable is similar to
define for procedure definitions except that the code for the procedure is integrated (some people would say inlined) whenever the procedure is called, eliminating the function-call overhead associated with the procedure. Any procedure defined with
define-integrable must appear in the source code before the first reference to the defined identifier. Lexical scoping is preserved, macros within the body of the defined procedure are expanded at the point of call, the actual parameters to an integrated procedure are evaluated once and at the proper time, integrable procedures may be used as first-class values, and recursive procedures do not cause indefinite recursive expansion.
Define-integrable appears in Section 8.4 of R. Kent Dybvig's book The Scheme Programming Language:
(define-syntax (define-integrable x)
(define (make-residual-name name)
(datum->syntax-object name
(string-append "residual-"
(symbol->string (syntax-object->datum name))))))
(syntax-case x (lambda)
((_ (name . args) . body)
(syntax (define-integrable name (lambda args . body))))
((_ name (lambda formals form1 form2 ...))
(identifier? (syntax name))
(with-syntax ((xname (make-residual-name (syntax name))))
(define-syntax (name x)
(syntax-case x ()
(_ (identifier? x) (syntax xname))
((_ arg (... ...))
((name (identifier-syntax xname)))
(lambda formals form1 form2 ...))
arg (... ...))))))
(define xname
(fluid-let-syntax ((name (identifier-syntax xname)))
(lambda formals form1 form2 ...)))))))))
Scheme provides hygienic macros (though
syntax-case provides a way to safely bend hygiene); Common Lisp, by comparison, provides unhygienic macros. There are some circumstances where unhygienic macros are more convenient than hygienic macros; Paul Graham provides numerous examples in his book On Lisp.
Define-macro provides unhygienic macros for Scheme:
(define-syntax (define-macro x)
(syntax-case x ()
((_ (name . args) . body)
(syntax (define-macro name (lambda args . body))))
((_ name transformer)
(define-syntax (name y)
(syntax-case y ()
((_ . args)
(syntax _)
(apply transformer
(syntax-object->datum (syntax args)))))))))))
The following examples are adapted from Graham's book:
(define-macro (when test . body) `(cond (,test . ,body)))
(define-macro (aif test-form then-else-forms)
`(let ((it ,test-form))
(if it ,then-else-forms)))
(define-macro (awhen pred? . body)
`(aif ,pred? (begin ,@body)))
When a macro breaks hygiene, it is sometimes useful to generate a unique symbol, which can be used as a variable name or in some other way. Here is the
gensym procedure:
(define gensym
(let ((n -1))
(lambda ()
(set! n (+ n 1))
(string-append "gensym-"
(number->string n))))))
Boxes provide a way to pass arguments to procedures by reference instead of the usual passing by value; put the argument in a box, then access and reset the argument in the procedure:
(define (box v) (vector v))
(define (unbox box) (vector-ref box 0))
(define (box! box v) (vector-set! box 0 v))


text:
Byron Bay, NSW
Regular price
Surfing The Pass is a right of passage for anyone who visits Byron Bay. I managed to capture a surfer making his way out to the line up. This Byron Bay print would look amazing on any wall. It's made to be viewed in landscape orientation.
Print Only - All prints come with a white border. All images are signed by the artist Ben Mackay.
Each image is printed on art paper stocks which has an incredible finish and an appearance that creates images with exceptional visual interest and texture depth. Made to last well over a century. They look amazing.
White or Raw Wood Frame - Professionally mounted. Comes printed with a white border on archival fine art stock paper rag. Non-reflective 2mm glass cover. 2cm wide, 4cm deep frame. Hanging system included. The design comes signed by the artist and looks amazing in any room.
Custom Orders - We also do a range of larger canvas, floating face acrylic mounts and custom sized print only and print / framed orders. Please contact us.
Shipping times may vary, as each product is made to order. Basically, once you order and pay, your item is then made custom for you. This means delivery can range from approx. 4 - 14 days more depending on the complexity of your order.
Express shipping options are also available in the checkout screen.
Unfortunately, Framed prints are not available to ship internationally. However we do ship rolled prints or canvas prints to anywhere in the world.

subset: commoncrawl


text:
Interesting new paper looking at electoral accountability in 74 countries
Corruption and Accountability: "Throwing the Bums Out" Does Not Work.
By Crisp, Potter, Olivella and Mishler (November 2012)
Many theories of democracy stress the concept of accountability. Voters reward or punish elected ocials by extending or ending their political careers. Seeking the long-term reward of reelection, officials avoid the short-term benefits of corruption that would put them at risk of early electoral defeat. This good behavior, in turn, leads to voter loyalty and reelection. Previous studies of electoral volatility and political corruption, however, have not tested this reciprocal relationship with an appropriate empirical model. In this paper, we employ a bivariate normal model to assess the effects of malfeasance on voter loyalty and, conversely, of voter defection on subsequent malfeasance. We test these relationships on data drawn from 249 elections across 74 countries. Our results show that malfeasance does indeed provoke voter defection, but that electoral volatility is not followed by lower levels of perceived corruption. We discuss the importance of these novel results for the emerging literature on clarity of responsibility.
Some excerpts from the conclusion (highlights are mine):
According to the standard theory, voters hold elected ocials accountable for their performance in oce by voting out of office anyone suspected of corrupt behavior. This presumably purges government of the worst officials, reminds continuing representatives of the voters' power, and signals to newly elected officials that they ought to behave more virtuously than their predecessors. The empirical evidence we have reported is reassuring of the standard model in only one respect. It clearly shows that voters respond appropriately to perceived corruption by throwing legislators out of office. Nevertheless, the observation that increasing volatility does not reduce perceived corruption undermines a central assumption of retrospective accountability theory: namely, that the replacement of corrupt officials creates a virtuous cycle where corruption and volatility are mutually reinforcing and spiral ever lower in tandem with one another.
The absence of any impact of volatility on perceived corruption means either that legislators do not alter their behavior in the short run in response to the signal provided by vote volatility, or that politicians do respond, but their change in behavior is not immediately perceived by voters who continue to punish newly elected legislators for the sins of their predecessors. Distinguishing between these possibilities, empirically, requires data on actual legislative corruption, which is not available. Nevertheless, weighing the two scenarios, in our estimation the second seems more plausible. In our data set, voter perceptions of legislative corruption appear highly viscous in that they do not vary much over time. Corruption is covert and hard for voters to recognize. When they do perceive corruption, voters respond appropriately by throwing the bums out of oce. But because corruption is covert, it is equally dicult for voters to know if newly elected legislators are really better behaved or whether the corruption of new members simply has not yet been exposed.
In the absence of visible evidence to the contrary, voters have no reason to update their perceptions and treat the new legislators any differently than the old ones. Rather than creating a virtuous cycle, this creates instead a low-level equilibrium trap. Voter perceptions of corruption give rise to higher levels of volatility, but because higher volatility has no systematic impact on subsequent perceptions of corruption, continuing perceptions of corruption are likely to sustain those higher levels of volatility, thereby threatening the re-election prospects of newly elected legislators regardless of their behavior. Our inability to find an effect of vote volatility on corruption by distinguishing quality democracies from low-grade ones (with an interaction with the country's Polity score) lends support to the idea that the failure of punishment to alter (perceptions of) corruption is not limited to some subset of delegative, authoritarian, or otherwised adjective-laden set of democracies.
Putting these findings in the broader context of the open government agenda, I can't help but wonder about the limits of transparency in the absence of additional accountability mechanisms.
Read the full paper here [PDF].


text:
The U.N.'s Hypocritical War on Pot
The organization's double standards stand in the way of commonsense drug policy.
David Sirota
The notion of alcohol consumers piously demanding that others stop using pot probably makes you think of the beer-swilling World War II generation berating weed-smoking hippies during the 1960s. Now, thanks to the United Nations, that caricature gets an update—and the hypocrisy is at once amusing and depressing.
You may have read the headline-grabbing news that in advance of its conference on drug policy this week, the U.N. issued a report urging the United States government to block Colorado and Washington state from moving forward with voter-approved laws that allow adult citizens to use marijuana as a less harmful alternative to alcohol. What you may not have heard is that on the very same day the U.N. released that report, U.S. ambassador Joseph Torsella slammed his U.N. colleagues for drinking too much on the job. Apparently, binging at the U.N. is so commonplace and excessive that it is hindering the organization from conducting its most basic work.
As hypocrisy humor goes, this is pretty funny. An international body immersed in one drug (alcohol) yet telling governments to outlaw an objectively less harmful drug (marijuana) is biting comedy. It hilariously exemplifies the double standards and contradictions that still define many global leaders' views of drugs.
Yet before you laugh too hard, remember that it is actually a tragedy for members of the U.N. to be simultaneously drinking too much alcohol and too much anti-pot Kool-Aid. It is a tragedy because the blatant hypocrisy saps the organization's credibility on the drug issue at a time when the world needs it to be supporting the international political momentum generated by Colorado and Washington state.
That reform momentum is now building as lawmakers in Mexico, Uruguay and Chile are citing the states' votes as reason for their nations to consider legislation to legalize marijuana. Likewise, according to the Associated Press, presidents of Mexico, Belize, Honduras and Costa Rica called "for the Organization of American States to study the impact of the Colorado and Washington votes and said the United Nations' General Assembly should hold a special session" to debate the continued prohibition of marijuana.
Their rationale is simple: Having seen their nations torn apart by the militarized fight against the drug cartels that rely on prohibition and its attendant black market, Latin American leaders see the Colorado and Washington victories as a way to finally start de-escalating the blood-soaked war on marijuana.
"Everyone is asking, 'What sense does it make to keep up such an intense confrontation, which has cost Mexico so much, by trying to keep this substance from going to a country where it's already regulated and permitted?'" one Mexican lawmaker told Time magazine in describing a bill he is pushing that is modeled off the Washington State measure.
The flip side, of course, is that legalization could deal a serious blow to the cartels. That's because, according to Mexico's Institute for Competitiveness, up to a third of the cartels' revenues come from the black-market marijuana trade—a trade that would be curtailed if cannabis was legalized and brought into the regulated economy. Meanwhile, if more American states follow Colorado and Washington, the cartels could "lose 24 percent of their gross export revenues," says Alejandro Hope, a former top intelligence official in Mexico.
Put it all together—thousands dead in a failed drug war, a massive black-market for marijuana and science that says pot is safer than alcohol—and the U.N. should be using its pivotal position to help the world move away from destructive prohibitionist policies and toward legalization and strict regulation.
In order for it to play such a constructive role, though, the U.N. clearly needs to sober up—both literally and politically.
David Sirota is an awardwinning investigative journalist and an In These Times senior editor. He served as speech writer for Bernie Sanders' 2020 campaign. Follow him on Twitter @davidsirota.


text:
Let's say you're one of "The Skeptics," ("The Burzynski Skeptics,") don't have a life (but doesn't that go without saying ?), enjoy associating yourself with known liars, cowards, ethically and intellectually challenged individuals, so you grab a newspaper (It's doubtful that USA TODAY would qualify), and if you do NOT know what a "Newsie" is, go online and select an article which has a plethora of innuendo and allegations, compose a missive to your member in Congress assembled about the nothingness you just reviewed, just don't piss yourself silly when you shoot that zinger off, because you've just sent something to your Congressperson, exhibiting what a whacky weed tobacco day tripper you are, and a prime example of what "Rocky Mountain High" really will mean, starting January 1st, 2014
Congratulations, Colorado
My only suggestion is that you add something like:
"Dear Congressperson Y,
I know your time is valuable, but please allow me to waste some of you and your staff's, as well as provide you with "fodder" you can hang up on the bathroom wall and laugh about for days!
In the next weeks I will be contacting you about all of the "conspiracy theories" in Jesse Ventura's book, including; but not limited to:
Area 51
The Denver International Airport
Smoke 'em if ya got 'em !
Dear CONGRESSPERSON'S NAME:
My name is _______ and I am one of your constituents
I am writing to you to request your urgent attention to a matter that involves the abuse of cancer patients, their families, and their communities
A few weeks ago, I wrote to you concerning the Houston cancer doctor Stanislaw Burzynski, and requested that you take action and look into how he was able to continue treating cancer patients for decades under the auspices of clinical trials with an unproven treatment he claims to have discovered, patented, manufactures, prescribes, and sells (at his in house pharmacy) at exorbitant prices
On Friday November 15, Dr. Burzynski was the subject of a front-page exposé in the USA Today
Additionally, since I last contacted your office, the FDA has released site inspection notes into the electronic FOIA reading room about Stanislaw Burzynski in his role as Principal Investigator (also included)
The findings were horrifying
Burzynski (as investigator, the subject of the inspection) "failed to comply with protocol requirements related to the primary outcome, therapeutic response […] for 67% of study subjects reviewed during the inspection."
This means that several patients who were reported as "complete responses" did not meet the criteria defined in the investigational plan, as were patients who were reported as having a "partial response" and "stable disease."
This means that his outcomes figures for these studies are inaccurate
Some patients admitted failed to meet the inclusion criteria for the study
Even though patients needed to have a physician back home to monitor their progress prior to enrolling in a trial, the FDA found a patient who began receiving treatment before a doctor had been found
The FDA told Burzynski:
"You failed to protect the rights, safety, and welfare of subjects under your care
Forty-eight (48) subjects experienced 102 investigational overdoses between January 1, 2005 and February 22, 2013, according to the [trial number redacted] List of Hospitalizations/SAE (serious adverse events) [redacted] Overdose [redacted]/Catheter Infection report
Overdose incidents have been reported to you [….]
There is no documentation to show that you have implemented corrective actions during this time period to ensure the safety and welfare of subjects." [emphasis added]
It seems that these overdoses are related to the protocol, which requires family members to administer the drugs via programmable pump on their own
Further, patient records show that there were many more overdoses that were not included in the Hospitalization/SAE/Overdose list
The FDA reported:
"Your […] tumor measurements initially recorded on worksheets at baseline and on-study treatment […] studies for all study subjects were destroyed and are not available for FDA inspectional review."
This is one of the most damning statements, as without any…not a single baseline measurement…there is no way to determine any actual effect of the antineoplaston treatment
This means that Burzynski's studies–which by last account cost $30,000 to begin and $7000 a month to maintain–are unpublishable
It will be stunning if this finding alone were not investigated by legal authorities
Patients who had Grade 3 or 4 toxic effects were supposed to be removed from treatment
One patient had 3 Grade 3 events followed by 3 Grade 4 events
Another patient had 7 disqualifying toxic events before he was removed from the study
Burzynski did not report all adverse events as required by his study protocols
One patient had 12 events of hypernatremia (high sodium), none of which was reported
There are several similar patients
Some adverse events were not reported to the Burzynski Clinic IRB for years
For instance one patient had an adverse event in 1998 and the oversight board did not hear about it until 2005.)
The FDA observed that the informed consent document did not include a statement of extra costs that might be incurred
Specifically, some informed consent documents were signed days to weeks before billing agreements, and in a couple of cases no consent form could be found
The clinic was unable to account for its stock of the investigational drug, an act that would get any other research lab shut down
Sadly, a child, Josia Cotto, had to die from apparent sodium overload before this investigation could be carried out
Despite these findings, when interviewed by USA Today, Burzynski actually said of his former cancer patients:
"As for criticism from former patients, Burzynski says, 'We see patients from various walks of life
We see great people
We see crooks
We have prostitutes
We have thieves
We have mafia bosses
We have Secret Service agents
Many people are coming to us, OK?
Not all of them are the greatest people in the world
And many of them would like to get money from us
They pretend they got sick and they would like to extort money from us.'"
I am asking you to help me understand what happened at the FDA to allow this man to conduct clinical trials and bankrupt patients in the process despite 10 years of alarming reviews by the FDA
I also ask you to support an investigation into this betrayal of over 8,000 patients and to push for legislation to prevent the most desperate patients from such unthinkable exploitation
I will be calling your office next week to touch base with you and I look forward to your response
Letter to Congress:
Burzynski: court cases
Main Page – Stanislawrajmundburzynski


text:
I got to participate in Roche's Fourth Social Media Summit last week. Naturally I brought my handheld recorder and chased down some of the other attendees to come on the podcast. The next hour covers a range of perspectives on the relationship between pharmaceutical companies and patients, diet soda, the future of DSMA, and much, much more. Enjoy.
There were a number of participants in this week's podcast. If you want to follow any of them on Twitter, here you go (in order of first appearance).
- @SweeterCherise
- @PortablPancGrl
- @ninjabetic
- @scottkjohnson
- @leeannthill
- @MrsCandyHearts
- @saraknic
- @sixuntilme
- @txtngmypancreas
- @ArdensDay
Run Time – 53:22
Send your feedback to email@example.com.
Subscribe on iTunes — Subscribe on Zune Marketplace — Stitcher Radio — Subscribe to the RSS Feed
Roche paid for my flight, hotel, and dining during my two days in Indianapolis. Commentary about the previously mentioned freebies is entirely optional on my part and in no way influenced by Roche or any affiliated parties. Besides, what fun would that be?


text:
Brief introduction to Research Resource Identifiers (RRIDs), persistent and unique identifiers for referencing a research resource.
Research Resource Identifiers (RRIDs) are ID numbers assigned to help researchers cite key resources (antibodies, model organisms and software projects) in the biomedical literature to improve transparency of research methods.
The Brain Imaging Data Structure (BIDS) is a standard prescribing a formal way to name and organize MRI data and metadata in a file system that simplifies communication and collaboration between users and enables easier data validation and software development through using consistent paths and naming for data files.
Neurodata Without Borders (NWB) is a data standard for neurophysiology that provides neuroscientists with a common standard to share, archive, use, and build common analysis tools for neurophysiology data.
The Neuroimaging Data Model (NIDM) is a collection of specification documents that define extensions the W3C PROV standard for the domain of human brain mapping. NIDM uses provenance information as means to link components from different stages of the scientific research process from dataset descriptors and computational workflow, to derived data and publication.
Neuroscience Information Exchange (NIX) Format data model allows storing fully annotated scientific datasets, i.e. the data together with rich metadata and their relations in a consistent, comprehensive format. Its aim is to achieve standardization by providing a common data structure and APIs for a multitude of data types and use cases, focused on but not limited to neuroscience. In contrast to most other approaches, the NIX approach is to achieve this flexibility with a minimum set of data model elements.
Computational models provide a framework for integrating data across spatial scales and for exploring hypotheses about the biological mechanisms underlying neuronal and network dynamics. However, as models increase in complexity, additional barriers emerge to the creation, exchange, and re-use of models. Successful projects have created standards for describing complex models in neuroscience and provide open source tools to address these issues. This lecture provides an overview of these projects and make a case for expanded use of resources in support of reproducibility and validation of models against experimental data.
NWB: An ecosystem for neurophysiology data standardization
Lecture on the most important concepts in software engineering
EEGLAB is an interactive Matlab toolbox for processing continuous and event-related EEG, MEG and other electrophysiological data incorporating independent component analysis (ICA), time/frequency analysis, artifact rejection, event-related statistics, and several useful modes of visualization of the averaged and single-trial data. EEGLAB runs under Linux, Unix, Windows, and Mac OS X.


text:
GetResponse Review – Why This Email Marketing Software Is a Must-Have
This GetResponse review will discuss how the software can help you improve your marketing efforts. With features like real-time tracking analytics, advanced segmentation, and a user-friendly website builder, this email marketing software can provide you with a winning combination of features. In addition, we'll discuss the many integrations available through GetResponse. Let's get started! What makes GetResponse such a must-have?
It is simple to use
There are some differences between GetResponse and other email marketing tools. The two are similar in that they allow you to build landing pages and newsletters, but they differ in a few significant areas. GetResponse can track website visitors and eCommerce, which is helpful in determining which campaigns are most effective. GetResponse also allows you to create custom landing pages.
GetResponse is easy to use, yet it has an impressive feature set that will help you make the most of it. Its autoresponder feature allows you to set up follow-up emails for new subscribers. These emails can be used for welcoming them, telling them about your new products and other pertinent information. It is an excellent tool for maximizing your marketing campaign and keeping track of your customers.
Automated emails can also be sent to your subscribers. These emails can direct your subscribers to a sales page where they can make a purchase. GetResponse offers eCommerce integrations that allow you to connect your shopping cart to a variety of eCommerce solutions. GetResponse's integrations can help you grow your business online and increase your sales. You can choose the features you need and get started with GetResponse today.
For a more advanced marketing strategy, GetResponse has an integrated CRM, Active Campaign. It is designed for small business owners, and its robust CRM features allow it to integrate with other common marketing channels. Although GetResponse may be a newer name in the email marketing industry, it offers many advantages such as mobile responsiveness, ease of use, and a wide range of integrations. EmailOctopus, which allows unlimited subscribers, domains, sends, and more, is a great drip campaign tool.
Advanced segmentation
Email marketing is incomplete without advanced segmentation. This feature can help you grow your company by allowing you address subscribers by name and contact information. You can also track analytics in real-time. Advanced segmentation is an option in many email software. However, it can be extremely helpful in driving business growth. Split testing is a feature of GetResponse that can help you determine which emails perform well based on the preferences of your subscribers.
Once your subscribers have signed up for your newsletter, you can begin sending them targeted emails. You can segment your subscribers by their interests, purchase history, or any other criteria that you choose. For example, if you want to send recommended products, you can create a segment for that based on previous purchases. This will allow you to tailor your message to your audience and increase revenue. Advanced segmentation helps you avoid wasting time and effort sending irrelevant emails.
Advanced segmentation in GetResponsE Review includes email marketing automation, email marketing, and ecommerce solutions. You can create a website using pre-built sections, SEO tools and central design control. In addition, you can add tags to your email campaign using Google Analytics. Zapier is a software platform that allows users to create rules that connect other programs. GetResponse can also be used with Zapier.
Another important feature of GetResponse is the conversion funnel. It transforms email marketing into an ecommerce platform. This feature is available on all paid plans, although the Free plan doesn't have ecommerce features, such as payment processing and abandoned cart recovery. Aside from conversion funnels, Advanced segmentation in GetResponse Review also includes advanced email marketing features. You can use GetResponse to segment subscribers using their preferences, demographics, and behavior.
Real-time tracking analytics
If you are new to email marketing, GetResponse has real-time tracking analytics. This tool provides a comprehensive view of email campaign performance, including conversion rates. Unfortunately, GetResponse's interface can be clunky. It is also difficult to use and you are unable to export performance reports. This is a major problem.
GetResponse has a basic CRM, but it's far from the most comprehensive solution. EngageBay, for example, offers a robust CRM system for teams of any size. It is easy to use and can be used by large and small companies. It has powerful features, including real-time tracking analytics and reporting tools. This CRM system can even send SMS/texts directly from the system.
Real-time tracking analytics can also help you know when to send emails and which time of day will generate the best response rates. GetResponse can predict when your subscribers will open your emails and tracks their social media activity. Based on this data, it will tell you when to send emails. If you have a large list of subscribers, you should use this feature.
GetResponse offers robust email automation tools as well as integrations with popular lead capture software. You can build complex workflows and track the outcomes of different marketing activities. Then, with the help of GetResponse real-time tracking analytics, you can easily determine which marketing campaigns are working and which ones need tweaking. GetResponse offers comprehensive marketing solutions that include email design and responsive mail design. GetResponse also offers email design, webinar software, and landing page generator.
GetResponse has integrations with a variety of services. Sign-up form integrations let you add or remove forms to your GetResponse accounts. You can also create your own form template, or just enter some basic HTML code. GetResponse offers a wide range of HTML forms. There is bound to be one that meets your needs.
The GetResponse API allows you to connect to more than 120 third-party platforms. You can integrate GetResponse with signup forms, CRM systems, and more. Import data from files or third-party services like PayPal, iContact, etc. is also possible. Integrations with GetResponse allow you to connect to other platforms and services.
Another great feature of GetResponse is the ability to segment your lists. Segmenting your list can be done based on clicks and email opens, or by using the email address of a specific person to target an audience. Additionally, you can create different types of ads based on the interests of your customers. You can track engagement levels and track the costs of your ads, too. Whether you're sending your newsletters to existing clients or targeting new prospects, GetResponse is the best choice for your email marketing needs.
GetResponse offers many features to help you create landing pages, in addition to email marketing. The Landing Page Creator feature comes with a library of over 100 pre-designed templates. Using a drag-and-drop editor, you can easily add items to your landing page. You can customize your landing page with custom code, sections, pop up forms, and other customizations. You can even collect payments through PayPal. Before you submit your landing page, you can preview it on desktop or mobile devices.
If you're in the market for an email marketing tool, GetResponse is worth checking out. This service is affordable for all businesses and allows them to create high-quality newsletters. The company has been in existence for over 20 years and has 1 billion subscribers around the world. GetResponse offers a wide variety of pricing plans, including a 30-day free trial.
Pricing for GetResponse varies depending on the size of your mailing list. The Starter plan is free, while the Pro plan costs $99 a month. If you have at least 500 subscribers, you can get a free account. Although you will need to pay for unlimited email sending, the free version is sufficient to get your list started. You will need to decide which plan is best for you.
The first plan is a free trial, which will allow you to use all features for 30 days. After that, you'll have to pay $4.00 per thousand subscribers to keep using the service. Once you've reached 100,000 subscribers, the monthly cost increases. In addition to the free plan, GetResponse offers four other plans, with varying pricing depending on how many contacts you have and how many features you need.
The best way to decide if GetResponse is right for you is to sign up for a free trial. It's possible to cancel at anytime if you decide that you don't like it. The company offers a free 30-day trial and you can cancel at anytime if you are not satisfied. However, it's important to understand your budget before signing up. Although the pricing of GetResponse may not be as important as other email marketing services such as MailChimp, it is important to evaluate the service.


text:
Today in the News: Egypt's president ousted
Quote of note
"The General Command of the Armed Forces told President Morsi around 7 p.m. that he is no longer a president for the republic." - Quote in Egypt's state-run newspaper Al-Ahram about President Mohamed Morsi. The country's first democratically elected president was ousted by the military, and the head of Egypt's high court was installed as an interim president.
News to know
Terrorists have threatened the 2014 Winter Olympics, Bleacher Report said. Chechen extremists sent a message to Russian President Vladimir Putin that they would use "maximum force" to disrupt the Games, which are set to take place in Sochi, Russia.
Hot video: 3-D printing creates 'bionic ear'
Researchers at Princeton University have the technology - they can't make you stronger or faster, but they can print out what they call a "bionic ear."
More Content Now


text:
Digital. Mobile. Social. Web. Newsletters. Magazines. Marketing. Mailings. Seriously, at Illustratus, we do it all. And because our powerful online platform is integrated into every important type of media, we make it so easy for you to look so good.
Connections. It's all about connections. Making them. Keeping them. Growing them. Using them. Let us show you how we can help you create and maintain the connections you need.


text:
Editorial: Convenience stores must stop peddling poison
Some of the newest and most dangerous drugs aren't sold in back alleys or on street corners anymore.
They're sold right out in the open, in your corner store. During the past year or so, a number of convenience and variety stores have been stocking a line of untested, unstable and potentially deadly products: synthetic drugs.
Known by a variety of names, including "bath salts," "Spice" and "K2," and packaged in colorful psychedelic packaging that might appeal to kids, at least one of the two classes of drugs — substituted cathinodes and synthetic cannabinoids — have been banned in at least 42 states, as well as by the federal government.
Manufacturers of the drugs and the unscrupulous store owners who sell them have kept ahead of the new federal ban by making minor changes in their chemical composition to keep them legal and unregulated. Some of these changes may make the drugs even more dangerous.
But you can still find these products sold in convenience stores, with the packets retailing anywhere from $10 to $40 in city stores. They're typically cooked up by amateur chemists in basements and garages. In addition to having intense effects and being easy to obtain, they're not detectable on drug tests and can't be easily detected by a distinctive odor.
Bath salts, which began to get increased attention in the media after a string of bizarre and violent incidents in Florida and New Jersey earlier this summer, look like crack cocaine or come in a capsule form. Substituted cathinones have effects similar to ecstasy, cocaine or meth — and they can create intense agitation, combative/violent behavior, confusion, hallucinations/psychosis, severe psychotic episodes, increased heart rate, hypertension, suicidal thoughts, chest pain and death or serious injury.
Meanwhile, cannabinoids — labeled as potpourri or incense, but clearly marketed with marijuana-related themes — mimic the effects of "super charged" marijuana, Vaillancourt said. The chemicals sprayed onto these legal herbs can be much more dangerous. He said that while there's very little research that's been conducted on these substances and their effects, they can be 300 to 500 times more potent than actual marijuana. Effects have an onset in just three to five minutes and can last up to three hours. The effects of bath salts, the doctor said, have an onset in 15 minutes and can last up to three hours.
All convenience-store customers should demand that their local corner store get these dangerous products out of our neighborhoods. Corner-store owners should not be acting as drug dealers. And, ironically, by selling these substances, these shopkeepers may very well be putting their own lives and livelihoods in jeopardy if a customer has a psychotic episode and becomes violent.
-- Fall River, Mass.


text:
Krishna Silver Rakhi
Krishna silver rakhi, adding joy and grace to your fest made in 92.5 silver.
Color: Silver
Dimensions: 1 width*2.3 length
Weight: Within 5gms
Delivery Time: Within 5 working days.
Due to covid delivery date and time may be affected. Please do cooperate.
Material Care: Silver should be stored wrapped in dry, acid-free tissue paper and placed inside cotton or tarnprufe bags.
All our products go through quality control before being shipped. All our products are handcrafted by local artisans. Each product might differ in some aspect. We DO NOT accept return if these slight difference are a cause of return.
The products are eligible for return or exchange if, they are damaged during transit or you have received a wrong size or a wrong product. In case your product is wrong or damaged, you need to intimate us within 3 days of receiving the product.
- Write to us at email@example.com or contact us @ +91-6307323933 within 3 days of receiving the product.
- After looking into the issue, someone from our team will review your message and get back to you within 48 hours over a mail or call.
- The return or exchange will only be made once the product is received by us in proper condition and packing.
The cost for reverse shipping i.e. getting us to collect it from you, will come at a cost of Rs. 150 which will be borne by the customer. The payment for the returns can be made via Paytm, google pay, bank transfer whichever is easier.
- We DO NOT provide REFUNDS.
- All items purchased from our website can be returned for a credit coupon within 14 days from the date of delivery. The entire amount of the returned product (excluding shipping cost) will be credited to the coupon code.
2. Jewellery should be stored in a dry place away from humidity, moisture and extreme temperatures.
3. Don't forget to remove your rings when washing up or showering, as soap particles may become lodged in stone settings and crevices.
4. Store your jewellery in it's own box or pouch to prevent scratching, chipping and entanglement.
5. Gentle rubbing with a silver cleaning cloth will restore the original briallance of the surface.


text:
I had some dates from Israel and decided to use them in a recipe, I was intrigued by the following one from Elizabeth Wolfe-Cohen's Perfect Jewish
Date & Nut Bread
Yields: 12 slices
- 1 1/2 cups self rising flour, plus a little more for dusting
- 1/4 tsp salt
- 1/2 – 1 tsp ground ginger [SYR used 1 tsp]
- 1 1/3 cups chopped dried dates [SYR did not use dried ones]
- 1 tsp bicarbonate of soda [baking soda]
- 2/3 cup boiling water
- 1 egg lightly beaten
- 1 tsp butter or margarine, softened [SYR used margarine to keep it pareve]
- 1 cup chopped walnuts, pecans or almonds [SYR used walnuts]DirectionsPreheat the oven to 325 F. Grease a 4″x8″ loaf pan. Line the base and and sides with nonstick baking parchment paper to come to 1″ above the sides. Grease again and dust with flour. Sift the flour, salt and ginger into a bowl.Put the dates into a large bowl with bicarbonate of soda. Pour over the boiling water and leave to stand for 5 minutes.Stir the egg and butter [or margarine if you prefer it pareve] and flour mixture into the date mixture and beat with a wooden spoon until well blended. Stir in the nuts. Pour the mixture into the loaf pan, smoothing the top. Tap the pan gently on a surface to expel any air bubbles.Bake in the center of the oven for 1 hour or until set and well colored and the bread begins to pull away from the sides of the pan; a knife inserted in the center should come out clean.Transfer to a wire rack to cool for 5 minutes , then leave to cool completely Using the paper as a guide, carefully remove the bread from the pan. If not serving the same day keep in the paper to prevent drying out.To serve, remove the paper from the base and sides, slice thinly.Prep time: 20 minutes – Bake Time – 1 hour
The bread came out very aromatic, it tasted subtly sweet, we had it with some cholov Yisroel Mascarpone cheese made at Pomegranate Supermarket's kitchen and recommended by their resident cheese expert, none other than our good friend Elizabeth Bland. We washed it down with a Herzog Selection Chateneuf 2009, a white semi dry with a fresh, fruity bouquet. The bread was delicious, the Mascarpone just right, and the wine proved a perfect pairing!