|
codepad
|
|
|
Saved pastes by programmingpraxis:
; ten-digit pandigital numbers divisible by 1 through 9
(define sort #f)
(define merge #f)
(let ()
|
view (57 lines, 4 lines of output) |
(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)))
|
view (34 lines, 4 lines of output) |
; project euler problem 1
(define (one n)
(let ((sieve (make-vector n 0)))
(do ((i 3 (+ i 3))) ((<= n i))
|
view (40 lines, 4 lines of output) |
; two stream selection questions
(define (range . args)
(case (length args)
((1) (range 0 (car args) (if (negative? (car args)) -1 1)))
|
view (139 lines, 13 lines of output, 1 comment) |
; closest pair, part 1
(define rand #f)
(define randint #f)
(let ((two31 #x80000000) (a (make-vector 56 -1)) (fptr #f))
|
view (87 lines, 13 lines of output) |
# sum of primes less than n
# algorithm of RodionGork
# for x = 3, 5, 7, 9, ... (odds) up to N
# for each prime p among those already found up to sqrt(N)
# check if x is divisible by p
|
view (23 lines, 2 lines of output) |
; largest forward difference
(define (largest-forward-difference xs)
(let ((lfd 0))
(do ((xs xs (cdr xs))) ((null? xs) lfd)
|
view (22 lines, 4 lines of output) |
; largest forward difference
(define (largest-forward-difference xs)
(let loop ((min-to-left (min (car xs) (cadr xs)))
(max-so-far (- (cadr xs) (car xs)))
|
view (13 lines, 2 lines of output) |
; godel numbering
(define primes (list 2 3 5 7 11 13 17 19 23 29
31 37 41 43 47 53 59 61 67 71 73 79 83 89 97))
|
view (23 lines, 2 lines of output) |
; lucas-carmichael number
(define-syntax fold-of
(syntax-rules (range in is)
((_ "z" f b e) (set! b (f b e)))
|
view (69 lines, 26 lines of output) |
; one-time pad
(define-syntax for
(syntax-rules ()
((for (var first past step) body ...)
|
view (50 lines, 40 lines of output) |
; diana cryptosystem
(define rand #f)
(define randint #f)
(let ((two31 #x80000000) (a (make-vector 56 -1)) (fptr #f))
|
view (117 lines, 7 lines of output) |
; magic squares
(define (make-matrix rows columns . value)
(do ((m (make-vector rows)) (i 0 (+ i 1)))
((= i rows) m)
|
view (104 lines, 21 lines of output) |
; every possible fraction
(define-syntax define-generator
(lambda (x)
(syntax-case x (lambda)
|
view (39 lines, 100 lines of output) |
; gray code neighbors
(define (logand a b)
(if (or (zero? a) (zero? b)) 0
(+ (* (logand (floor (/ a 2)) (floor (/ b 2))) 2)
|
view (24 lines, 4 lines of output) |
; ancient algorithms
(define (product left right)
(let loop ((left left) (right right) (prod 0))
(if (zero? left) prod
|
view (73 lines, 10 lines of output) |
; a prime number puzzle
(define (two-digit-primes)
(let ((sieve (make-vector 100 #t)))
(do ((p 2 (+ p 1))) ((<= 100 p) (newline))
|
view (11 lines, 1 line of output) |
; thou impertinent urchin-faced miscreant
(define (string-join sep ss)
(define (f s ss)
(string-append s (string sep) ss))
|
view (200 lines, 11 lines of output) |
; an array of zeroes
(define (zeroes vec)
(let loop ((lo 0) (hi (- (vector-length vec) 1)) (counter 0))
(cond ((< hi lo) (values counter vec))
|
view (40 lines, 5 lines of output) |
; damm algorithm
; http://en.wikipedia.org/wiki/Damm_algorithm
(define (digits n . args)
(let ((b (if (null? args) 10 (car args))))
|
view (34 lines, 2 lines of output) |
; dawkins weasel
(define (range . args)
(case (length args)
((1) (range 0 (car args) (if (negative? (car args)) -1 1)))
|
view (118 lines, 94 lines of output) |
; dawkins weasel
; http://en.wikipedia.org/wiki/Weasel_program
(define (range . args)
(case (length args)
|
view (96 lines, 58 lines of output) |
# favorite color
awk ' /^favoritecolor: / { color[$2]++ }
END { for (c in color) print color[c], c } ' database |
sort -rn |
|
view (7 lines) |
; gaussian integers, part 1
(define (gs a b) (cons a b))
(define (re x) (car x))
(define (im x) (cdr x))
|
view (157 lines, 2 lines of output) |
; gaussian integers, part 1
(define (gs a b) (cons a b))
(define (re x) (car x))
(define (im x) (cdr x))
|
view (157 lines, 1 line of output) |
; gaussian integers, part 1
(define (gs a b) (cons a b))
(define (re x) (car x))
(define (im x) (cdr x))
|
view (77 lines) |
; number of divisors in a range
(define (f x y n)
(- (quotient (- y 1) n)
(quotient x n)))
|
view (11 lines, 5 lines of output) |
; three farmers
(define-syntax fold-of
(syntax-rules (range in is)
((_ "z" f b e) (set! b (f b e)))
|
view (42 lines, 1 line of output) |
; two-base palindromes
(define (digits n . args)
(let ((b (if (null? args) 10 (car args))))
(let loop ((n n) (d '()))
|
view (18 lines, 30 lines of output) |
; two-base palindromes
(define (digits n . args)
(let ((b (if (null? args) 10 (car args))))
(let loop ((n n) (d '()))
|
view (59 lines, 28 lines of output) |
; blackjack
(define (take n xs)
(let loop ((n n) (xs xs) (ys '()))
(if (or (zero? n) (null? xs))
|
view (163 lines, 1 line of output) |
; spiral wrapping
(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))
|
view (21 lines, 1 line of output) |
; belphegor primes
(define (isqrt n)
(if (not (and (positive? n) (integer? n)))
(error 'isqrt "must be positive integer")
|
view (116 lines, 5 lines of output) |
import sys
def justify(filename, width = 60):
with open(filename, 'r') as file:
words, cnt, size, dir = [], 0, 0, 0
|
view (32 lines) |
; text formatting
(define (read-line . port)
(define (eat p c)
(if (and (not (eof-object? (peek-char p)))
|
view (49 lines) |
; wheel factorization
(define (last-pair xs)
(if (null? (cdr xs)) xs
(last-pair (cdr xs))))
|
view (17 lines, 1 line of output) |
; thue-morse sequence
(define (complement digits)
(map (lambda (d) (if (zero? d) 1 0)) digits))
|
view (11 lines, 1 line of output) |
; blum's mental hash
(define f (vector 8 3 7 1 8 5 6 3 0
1 2 7 2 8 4 1 0 4 9 2 5 5 6 7 3 9))
|
view (41 lines, 2 lines of output) |
; triangle roll-up
(define (but-last xs) (reverse (cdr (reverse xs))))
(define (pair-wise f xs) (map f (but-last xs) (cdr xs)))
|
view (12 lines, 5 lines of output) |
; diophantine reciprocals
(define (xy-pairs n)
(let loop ((x (+ n 1)) (xys (list)))
(if (< (+ n n) x)
|
view (43 lines, 5 lines of output) |
; diophantine reciprocals
(define (last-pair xs)
(let ((tail (cdr xs)))
(if (pair? tail) (last-pair tail) xs)))
|
view (30 lines, 2 lines of output) |
; torn numbers
(define (torn? n)
(define (square x) (* x x))
(let loop ((ten-power 10))
|
view (13 lines, 12 lines of output) |
; levenshtein distance
(define (make-matrix rows columns . value)
(do ((m (make-vector rows)) (i 0 (+ i 1)))
((= i rows) m)
|
view (47 lines, 8 lines of output) |
; skyline puzzle
(define (heights buildings)
(let* ((len (apply max (map caddr buildings)))
(hites (make-vector (+ len 1) 0)))
|
view (19 lines, 1 line of output) |
; longest increasing subsequence
(define (deal deck)
(let loop ((deck deck) (selip (list)) (piles (list)))
(cond ((null? deck) piles) ; no more cards in deck
|
view (60 lines, 6 lines of output) |
; generating palindromes
(define (digits n . args)
(let ((b (if (null? args) 10 (car args))))
(let loop ((n n) (d '()))
|
view (62 lines, 103 lines of output) |
; patience sorting
(define (deal deck)
(let loop ((deck deck) (selip (list)) (piles (list)))
(cond ((null? deck) piles) ; no more cards in deck
|
view (46 lines, 2 lines of output) |
; big modular exponentiation
(define p 34534985349875439875439875349875)
(define q 93475349759384754395743975349573495)
(define m (+ (expt 10 9) 7))
|
view (17 lines, 2 lines of output) |
; minimal palindromic base
(define (range . args)
(case (length args)
((1) (range 0 (car args) (if (negative? (car args)) -1 1)))
|
view (46 lines, 1 line of output) |
; minimal palindromic base
(define (range . args)
(case (length args)
((1) (range 0 (car args) (if (negative? (car args)) -1 1)))
|
view (46 lines, 3 lines of output) |
; minimal palindromic base
(define (range . args)
(case (length args)
((1) (range 0 (car args) (if (negative? (car args)) -1 1)))
|
view (46 lines, 3 lines of output) |
; minimal palindromic base
(define (range . args)
(case (length args)
((1) (range 0 (car args) (if (negative? (car args)) -1 1)))
|
view (46 lines, 1 line of output) |
/* montgomery multiplication */
typedef unsigned long long ull;
typedef signed long long sll;
|
view (112 lines, 2 lines of output) |
; number words
(define (digits n . args)
(let ((b (if (null? args) 10 (car args))))
(let loop ((n n) (d '()))
|
view (26 lines, 1 line of output) |
; how fermat factored integers
(define (sprintf fmt . args)
(define (escape cs)
(define (octal? c) (char<=? #\0 c #\7))
|
view (133 lines, 181 lines of output) |
; how many distinct products in a times table?
(define (m n) ; brute force
(let ((bits (make-vector (+ (* n n) 1) #f)))
(do ((i 1 (+ i 1))) ((< n i))
|
view (23 lines, 2 lines of output) |
# Square Form Factorization
# Jason E Gower and Samuel S Wagstaff Jr
# AMS Mathematics of Computation
# Volume 77, Number 261, January 2008, Pages 551-588
# S 0025-5718(07)02010-8
|
view (152 lines, 564 lines of output) |
# Square Form Factorization
# Jason E Gower and Samuel S Wagstaff Jr
# AMS Mathematics of Computation
# Volume 77, Number 261, January 2008, Pages 551-588
# S 0025-5718(07)02010-8
|
view (132 lines, 464 lines of output) |
# moonrise / moonset
from __future__ import division
from math import sqrt, pi, sin, cos, atan
|
view (182 lines, 2 lines of output, 1 comment) |
; minimum and maximum
(define (first-min-max xs)
(if (null? xs) (error 'first-min-max "empty input")
(list (apply min xs) (apply max xs))))
|
view (68 lines, 13 lines of output) |
# prime numbers
def primes(n): # sieve of eratosthenes
i, p, ps, m = 0, 3, [2], n // 2
sieve = [True] * m
|
view (110 lines, 1 line of output) |
; busy beaver
(define (make-hash hash eql? oops size)
(let ((table (make-vector size '())))
(lambda (message . args)
|
view (150 lines, 135 lines of output) |
; minimax pandigital factor
(define (range . args)
(case (length args)
((1) (range 0 (car args) (if (negative? (car args)) -1 1)))
|
view (110 lines, 43 lines of output) |
; balanced delimiters
(define (balanced? str)
(let ((starters '(#\( #\[ #\{)) (enders '(#\) #\] #\})))
(let loop ((cs (string->list str)) (xs (list)))
|
view (19 lines, 1 line of output) |
; minimax pandigital factor
; http://www.reddit.com/r/math/comments/2749y4/
; a_problem_i_came_up_with_and_havent_been_able_to/
|
view (98 lines, 43 lines of output) |
; remove singleton
(define (remove-singleton c str)
(define (none ins outs)
(cond ((null? ins) outs)
|
view (46 lines) |
; roman numerals
(define-syntax list-match
(syntax-rules ()
((_ expr (pattern fender ... template) ...)
|
view (81 lines, 2 lines of output) |
; subset sum clrs 35.5, part 2
(define (filter pred? xs)
(let loop ((xs xs) (ys '()))
(cond ((null? xs) (reverse ys))
|
view (73 lines, 4 lines of output) |
; subset sums clrs 35.5
(define (filter pred? xs)
(let loop ((xs xs) (ys '()))
(cond ((null? xs) (reverse ys))
|
view (50 lines, 5 lines of output) |
; aliquot sequences
(define (factors n)
(define (last-pair xs) (if (null? (cdr xs)) xs (last-pair (cdr xs))))
(define (cycle . xs) (set-cdr! (last-pair xs) xs) xs)
|
view (36 lines, 235 lines of output) |
; rolling code
(define fob1
(let ( ; permanent read-only memory
(id 111) (k 948579992)
|
view (72 lines, 6 lines of output) |
; three interview questions
(define (subtract-first-half xs)
(let loop ((front xs) (back (reverse xs)) (hare xs) (out (list)))
(if (or (null? hare) (null? (cdr hare)))
|
view (18 lines, 3 lines of output) |
; packed ascii
(define (drop n xs)
(let loop ((n n) (xs xs))
(if (or (zero? n) (null? xs)) xs
|
view (56 lines, 1 line of output) |
; binary reflected gray code
(define (ash int cnt)
(if (negative? cnt)
(let ((n (expt 2 (- cnt))))
|
view (36 lines, 16 lines of output) |
; assembler, part 3
(define (sprintf fmt . args)
(define (escape cs)
(define (octal? c) (char<=? #\0 c #\7))
|
view (168 lines) |
; assembler, part 2
(define labels (list))
(define opcodes '(("const" . 0) ("get" . 1) ("put" . 2)
|
view (69 lines) |
; assembler, part 1
(define labels (list))
(define opcodes '(("const" . 0) ("get" . 1) ("put" . 2)
|
view (52 lines) |
; plotter - plot graph based on input parameters
(define (make-matrix rows columns . value)
(do ((m (make-vector rows)) (i 0 (+ i 1)))
((= i rows) m)
|
view (146 lines) |
; factoring with bicycle chains
(define (isqrt n)
(if (not (and (positive? n) (integer? n)))
(error 'isqrt "must be positive integer")
|
view (46 lines, 1 line of output) |
; formatted output
(define (sprintf fmt . args)
(define (escape cs)
(define (octal? c) (char<=? #\0 c #\7))
|
view (76 lines, 4 lines of output) |
; factoring rsa moduli
(define (expm b e m)
(define (m* x y) (modulo (* x y) m))
(cond ((zero? e) 1)
|
view (49 lines, 25 lines of output) |
; lucky numbers
(define (range . args)
(case (length args)
((1) (range 0 (car args) (if (negative? (car args)) -1 1)))
|
view (27 lines, 1 line of output) |
; caesar cipher
(define (caesar n str)
(define (char-plus c)
(let ((alpha "ABCDEFGHIJKLMNOPQRSTUVWXYZ"))
|
view (12 lines, 2 lines of output) |
; factoring by digital coding
(define (mappend f . xss)
(apply append (apply map f xss)))
|
view (36 lines, 2 lines of output) |
; combined n +/- 1 primality prover
; primes n -- list of primes not greater than n in ascending order
(define (primes n) ; assumes n is an integer greater than one
(let* ((len (quotient (- n 1) 2)) (bits (make-vector len #t)))
|
view (281 lines, 1 line of output) |
; combined n +/- 1 primality prover
; primes n -- list of primes not greater than n in ascending order
(define (primes n) ; assumes n is an integer greater than one
(let* ((len (quotient (- n 1) 2)) (bits (make-vector len #t)))
|
view (277 lines, 5 lines of output) |
; modest prime-number library
(defn gcd "greatest common divisor" [a b]
(if (zero? b) a (gcd b (mod a b))))
|
view (69 lines) |
; crossing hands
(define (range . args)
(case (length args)
((1) (range 0 (car args) (if (negative? (car args)) -1 1)))
|
view (22 lines, 11 lines of output) |
; anagrams within words
(define (take n xs)
(let loop ((n n) (xs xs) (ys '()))
(if (or (zero? n) (null? xs))
|
view (66 lines, 2 lines of output) |
; years, months, days
(define-syntax (define-structure x)
(define (gen-id template-id . args)
(datum->syntax-object template-id
|
view (67 lines) |
; n+1 primality prover
(define (jacobi a m)
(if (not (integer? a)) (error 'jacobi "must be integer")
(if (not (and (integer? m) (positive? m) (odd? m)))
|
view (64 lines, 2 lines of output) |
; lucas pseudoprimes
(define-syntax fold-of
(syntax-rules (range in is)
((_ "z" f b e) (set! b (f b e)))
|
view (247 lines, 1 line of output) |
; reservoir sampling
(define (take n xs)
(let loop ((n n) (xs xs) (ys '()))
(if (or (zero? n) (null? xs))
|
view (46 lines, 3 lines of output) |
; factoring factorials
(define (primes n)
(let ((sieve (make-vector (+ n 1) #t)))
(let loop ((p 2) (ps (list)))
|
view (36 lines, 3 lines of output) |
; shuffle box
(define knuth
(let* ((a 69069) (c 1234567) (m 4294967296)
(seed (current-seconds)))
|
view (55 lines, 3 lines of output) |
; minimum standard random number generator
(define (logand a b)
(if (or (zero? a) (zero? b)) 0
(+ (* (logand (floor (/ a 2)) (floor (/ b 2))) 2)
|
view (53 lines, 8 lines of output) |
; baillie-wagstaff pseudoprimality test
(define (isqrt n)
(if (not (and (positive? n) (integer? n)))
(error 'isqrt "must be positive integer")
|
view (207 lines, 17 lines of output) |
; lucas sequences
(define (range . args)
(case (length args)
((1) (range 0 (car args) (if (negative? (car args)) -1 1)))
|
view (152 lines, 446 lines of output) |
; counting zeros
(define (filter pred? xs)
(let loop ((xs xs) (ys '()))
(cond ((null? xs) (reverse ys))
|
view (41 lines, 3 lines of output) |
; o tannenbaum
; rand -- returns integer on range 0 .. 2^32-1
(define rand ; marsaglia linear congruential method
(let* ((a 69069) (c 1234567) (m 4294967296)) ; due to knuth
|
view (38 lines, 23 lines of output) |
; remove duplicates from a list
(define (range . args)
(case (length args)
((1) (range 0 (car args) (if (negative? (car args)) -1 1)))
|
view (312 lines, 3 lines of output) |
; prime-count and prime-sum
; http://www.icecreambreakfast.com/primecount/PrimeCountingSurvey.pdf
(define (factors n) ; trial division
(let loop ((n n) (f 2) (fs (list)))
|
view (82 lines, 5 lines of output) |
; prime-count and prime-sum
; http://www.icecreambreakfast.com/primecount/PrimeCountingSurvey.pdf
(define (factors n) ; trial division
(let loop ((n n) (f 2) (fs (list)))
|
view (81 lines, 5 lines of output) |
; rock paper scissors
(define rand #f)
(define randint #f)
(let ((two31 #x80000000) (a (make-vector 56 -1)) (fptr #f))
|
view (99 lines) |
; reversing parts of a list
(define (take n xs)
(let loop ((n n) (xs xs) (ys '()))
(if (or (zero? n) (null? xs))
|
view (37 lines, 6 lines of output) |
; fletcher's checksum
(define (readc n)
(if (eof-object? (peek-char)) -1
(let loop ((k n) (v 0))
|
view (27 lines) |
/* sum of primes less than two million */
#include <stdlib.h>
#include <stdio.h>
#include <string.h>
|
view (37 lines, 1 line of output) |
(define (puddle land)
(let loop ((volume 0) (lmax 0) (rmax 0) (left 0)
(right (- (vector-length land) 1)))
(cond ((<= right left) volume)
((< lmax (vector-ref land left))
|
view (18 lines, 4 lines of output) |
; minimum hamming distance
(define (logand a b)
(if (or (zero? a) (zero? b)) 0
(+ (* (logand (floor (/ a 2)) (floor (/ b 2))) 2)
|
view (42 lines, 2 lines of output) |
; two stacks make a queue
(define sEmpty (list))
(define (sPush s x) (cons x s))
(define (sHead s) (if (null? s) (error 'sHead "oops") (car s)))
|
view (54 lines, 5 lines of output) |
; queues
(define (make-queue) (list (list)))
(define (enqueue q x) (cons (car q) (cons x (cdr q))))
|
view (34 lines, 5 lines of output) |
; the 16 game
(define (range . args)
(case (length args)
((1) (range 0 (car args) (if (negative? (car args)) -1 1)))
|
view (83 lines, 1 line of output) |
; pessimal algorithms and simplexity analysis
(define (slowsort a i j)
(when (< i j)
(let ((m (quotient (+ i j) 2)))
|
view (17 lines, 2 lines of output) |
; david gries' coffee can problem
(define rand #f)
(define randint #f)
(let ((two31 #x80000000) (a (make-vector 56 -1)) (fptr #f))
|
view (83 lines, 2 lines of output) |
; binary tree traversal
(define (split-while pred? xs)
(let loop ((xs xs) (ys '()))
(if (or (null? xs) (not (pred? (car xs))))
|
view (62 lines, 4 lines of output) |
; find the minimum difference
(define (f xs ys)
(let ((d (- (car xs) (car ys))))
(let loop ((xs xs) (ys ys) (diff (abs d)))
|
view (13 lines, 1 line of output) |
; functional-style linked lists
(define (error symb str)
(display "error: ")
(display (symbol->string symb))
|
view (65 lines, 9 lines of output) |
; lucas sequences
(define (lucas l2 l1 n)
(let loop ((n n) (l2 l2) (l1 l1) (ls (list l1 l2)))
(if (zero? n) (reverse ls)
|
view (36 lines, 6 lines of output) |
# interval heap
# www.keithschwarz.com/interesting/code/?dir=interval-heap
# pq[1..n, "lo"|"hi"] is the priority queue
# size is the number of elements in the queue
|
view (135 lines) |
; finding digit strings in powers of two
(define (string-find pat str . s)
(let* ((plen (string-length pat))
(slen (string-length str))
|
view (36 lines, 2 lines of output) |
; smallest consecutive four-factor composites
(define (unique eql? xs)
(cond ((null? xs) '())
((null? (cdr xs)) xs)
|
view (47 lines, 1 line of output) |
; diffie hellman key exchange
(define (expm b e m)
(define (m* x y) (modulo (* x y) m))
(cond ((zero? e) 1)
|
view (12 lines, 4 lines of output) |
; cartesian product
(define-syntax fold-of
(syntax-rules (range in is)
((_ "z" f b e) (set! b (f b e)))
|
view (82 lines, 4 lines of output) |
; two sieving problems
(define (primes n)
(let ((ps (list)) (sieve (make-vector (+ n 1) #t)))
(do ((p 2 (+ p 1))) ((< n p) (reverse ps))
|
view (103 lines, 3 lines of output) |
; two sieving problems
(define (primes n)
(let ((ps (list)) (sieve (make-vector (+ n 1) #t)))
(do ((p 2 (+ p 1))) ((< n p) (reverse ps))
|
view (90 lines, 2 lines of output) |
; primes congruent to 1 (mod 4)
(define (isqrt n)
(if (not (and (positive? n) (integer? n)))
(error 'isqrt "must be positive integer")
|
view (46 lines, 3 lines of output) |
; primes congruent to 1 (mod 4)
(define (isqrt n)
(if (not (and (positive? n) (integer? n)))
(error 'isqrt "must be positive integer")
|
view (45 lines, 1 line of output) |
; primes congruent to 1 (mod 4)
(define (isqrt n)
(if (not (and (positive? n) (integer? n)))
(error 'isqrt "must be positive integer")
|
view (51 lines, 1 line of output) |
; sophie germain primes
(define (inverse x m)
(let loop ((x x) (a 0) (b m) (u 1))
(if (positive? x)
|
view (186 lines, 210 lines of output) |
; ordered hash tables
(define (range . args)
(case (length args)
((1) (range 0 (car args) (if (negative? (car args)) -1 1)))
|
view (146 lines) |
; who buys the croissants
(define (drop n xs)
(let loop ((n n) (xs xs))
(if (or (zero? n) (null? xs)) xs
|
view (104 lines, 2 lines of output) |
; find x[i] = i in an array
(define x (vector -3 -1 0 3 5 7))
(define y (vector -3 -1 0 2 5 7))
|
view (26 lines, 4 lines of output) |
; telephone lookup
(define (range . args)
(case (length args)
((1) (range 0 (car args) (if (negative? (car args)) -1 1)))
|
view (466 lines, 2 lines of output) |
; j k rowling
(define (make-matrix rows columns . value)
(do ((m (make-vector rows)) (i 0 (+ i 1)))
((= i rows) m)
|
view (324 lines) |
; vampire numbers
(define (digits n . args)
(let ((b (if (null? args) 10 (car args))))
(let loop ((n n) (d '()))
|
view (85 lines, 9 lines of output) |
; weekdays between two dates
(define (julian year month day)
(let* ((a (quotient (- 14 month) 12))
(y (+ year 4800 (- a)))
|
view (32 lines, 8 lines of output) |
; decoding text-speak
(define (filter pred? xs)
(let loop ((xs xs) (ys '()))
(cond ((null? xs) (reverse ys))
|
view (254 lines, 1 line of output) |
; a programming puzzle
(define (f n)
(cond ((and (positive? n) (even? n)) (- n 1))
((and (negative? n) (even? n)) (+ n 1))
|
view (16 lines, 7 lines of output) |
; swap list nodes
(define (swap-kth-nodes xs k)
(let loop1 ((a xs) (b xs) (k (- k 1)))
(if (null? a) xs
|
view (23 lines, 10 lines of output) |
; 3sum
(define-syntax fold-of
(syntax-rules (range in is)
((_ "z" f b e) (set! b (f b e)))
|
view (279 lines, 3 lines of output) |
; the digits of pi, again
(define (isqrt n)
(if (not (and (positive? n) (integer? n)))
(error 'isqrt "must be positive integer")
|
view (35 lines, 144 lines of output) |
; longest substring of two unique characters
(define (make-set limit)
(define (hash x) ; universal hash function
|
view (136 lines, 3 lines of output) |
; dixon's method with xor-merge
(define (isqrt n)
(if (not (and (positive? n) (integer? n)))
(error 'isqrt "must be positive integer")
|
view (153 lines, 1 line of output) |
; egyptian fractions
(define (egypt n d)
(let loop ((n n) (d d) (xs (list)))
(if (= n 1) (reverse (cons d xs))
|
view (12 lines, 3 lines of output) |
; modular multiplication without overflow
(define (mod-mul a b m) ; assumes a,b < 2^64 and m < 2^63
(define (shift x k)
(let loop ((k k) (x x))
|
view (30 lines, 1 line of output) |
; coin change, part 3
(define (make-hash hash eql? oops size)
(let ((table (make-vector size '())))
(lambda (message . args)
|
view (139 lines, 10 lines of output) |
; coin change, part 2
(define (make-matrix rows columns . value)
(do ((m (make-vector rows)) (i 0 (+ i 1)))
((= i rows) m)
|
view (51 lines, 2 lines of output) |
; coin change, part 1
(define (count xs n)
(let ((cs (make-vector (+ n 1) 0)))
(vector-set! cs 0 1)
|
view (25 lines, 32 lines of output) |
; mindcipher
(define (take n xs)
(let loop ((n n) (xs xs) (ys '()))
(if (or (zero? n) (null? xs))
|
view (89 lines, 4 lines of output) |
; three list exercises
(define (remove-nth n xs)
(let loop ((i 1) (xs xs) (zs (list)))
(cond ((null? xs) (reverse zs))
|
view (59 lines, 15 lines of output) |
; first unrepeated character in a string
(define (f str)
(let ((len (string-length str)) (x (make-vector 256 -1)))
(do ((i 0 (+ i 1))) ((= i len))
|
view (40 lines, 4 lines of output) |
; correct horse battery staple
(define rand #f)
(define randint #f)
(let ((two31 #x80000000) (a (make-vector 56 -1)) (fptr #f))
|
view (410 lines, 25 lines of output) |
; correct horse battery staple
(define (take n xs)
(let loop ((n n) (xs xs) (ys '()))
(if (or (zero? n) (null? xs))
|
view (443 lines, 25 lines of output) |
; date formatting
(define-syntax list-match
(syntax-rules ()
((_ expr (pattern fender ... template) ...)
|
view (114 lines, 5 lines of output) |
; date formatting
(define-syntax list-match
(syntax-rules ()
((_ expr (pattern fender ... template) ...)
|
view (113 lines, 4 lines of output) |
; cyclic equality
(define (cycle . xs) (set-cdr! (last-pair xs) xs) xs)
(define (last-pair xs)
|
view (33 lines, 8 lines of output) |
# lucas pseudoprimality test
def iSqrt(n):
if type(n) not in (int, long): raise TypeError, "must be integer"
if n < 1: raise ValueError, "must be positive"
|
view (105 lines, 8 lines of output) |
; baillie-wagstaff pseudoprimality test
(define (isqrt n)
(if (not (and (positive? n) (integer? n)))
(error 'isqrt "must be positive integer")
|
view (129 lines, 8 lines of output) |
; last non-zero digit of a factorial
(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))
|
view (66 lines, 5 lines of output) |
; one million hits
(define (eratosthenes n)
(let ((sieve (make-vector (+ n 1) #t)))
(let loop ((p 2) (ps (list)))
|
view (13 lines, 1 line of output) |
; google code jam qualification round africa 2010, revisited
(define (make-dict lt?)
(define-syntax define-generator
|
view (403 lines, 19 lines of output) |
; jumping jack
(define (range . args)
(case (length args)
((1) (range 0 (car args) (if (negative? (car args)) -1 1)))
|
view (38 lines, 49 lines of output) |
; an array of two symbols
(define (make-list n x)
(let loop ((n n) (xs '()))
(if (zero? n) xs
|
view (66 lines, 6 lines of output) |
; buffon's needle
(define rand #f)
(define randint #f)
(let ((two31 #x80000000) (a (make-vector 56 -1)) (fptr #f))
|
view (58 lines, 1 line of output) |
; an array of two symbols
(define (make-list n x)
(let loop ((n n) (xs '()))
(if (zero? n) xs
|
view (66 lines, 8 lines of output) |
; quadratic sieve
; f: maximum prime in factor base
; 2*m: number of entries in sieve
; relations with x in car and ys in cdr
; examples
|
view (233 lines, 3 lines of output) |
# lucas pseudoprimality test
def iSqrt(n):
if type(n) not in (int, long): raise TypeError, "must be integer"
if n < 1: raise ValueError, "must be positive"
|
view (104 lines, 7 lines of output) |
; baillie-wagstaff pseudoprimality test
(define (isqrt n)
(if (not (and (positive? n) (integer? n)))
(error 'isqrt "must be positive integer")
|
view (127 lines, 7 lines of output) |
; an odd way to square
(define (square n)
(let loop ((x n) (s 0))
(if (zero? x) (+ s s (- n))
|
view (25 lines, 6 lines of output) |
; lucas pseudoprimality tester
; based on trn.c from http://www.trnicely.net/misc/bpsw.html
; jacobi a m -- jacobi symbol
|
view (48 lines, 19 lines of output) |
# lucas pseudoprimality tester
# based on trn.c from http://www.trnicely.net/misc/bpsw.html
def gcd(a, b):
|
view (50 lines, 17 lines of output) |
# lucas pseudoprimality tester
# based on trn.c from http://www.trnicely.net/misc/bpsw.html
def gcd(a, b):
|
view (50 lines, 17 lines of output) |
; lucas pseudoprimality tester
; based on trn.c from http://www.trnicely.net/misc/bpsw.html
; jacobi a m -- jacobi symbol
|
view (48 lines, 19 lines of output) |
; floupia
(define (filter pred? xs)
(let loop ((xs xs) (ys '()))
(cond ((null? xs) (reverse ys))
|
view (51 lines, 8 lines of output) |
; floupia
(define (filter pred? xs)
(let loop ((xs xs) (ys '()))
(cond ((null? xs) (reverse ys))
|
view (49 lines, 7 lines of output) |
; npr sunday puzzle
(define (take n xs)
(let loop ((n n) (xs xs) (ys '()))
(if (or (zero? n) (null? xs))
|
view (30 lines) |
; facebook hacker cup 2013, round 1, problem 1
(define (drop n xs)
(let loop ((n n) (xs xs))
(if (or (zero? n) (null? xs)) xs
|
view (64 lines, 5 lines of output) |
; binary search tree: in-order predecessor and successor
(define (tree key lkid rkid) (vector key lkid rkid))
(define (key tree) (vector-ref tree 0))
|
view (84 lines, 25 lines of output) |
/* bigprime.c -- save the digits of 2^57885161-1 to a file */
#include <stdio.h>
#include "gmp.h"
|
view (17 lines) |
; the 147 puzzle
(define (f k)
(let ((fss (list)))
(let loop1 ((k k) (n 1) (d 1) (fs (list)))
|
view (22 lines, 147 lines of output) |
; hofstadter's sequence
; Copyright (C) 2007 by Philip L. Bewig of Saint Louis, Missouri, USA. All rights
; reserved. Permission is hereby granted, free of charge, to any person obtaining a copy of
; this software and associated documentation files (the "Software"), to deal in the Software
|
view (605 lines, 2 lines of output) |
; hofstadter's sequence
(define (hofstadter n)
(let ((k 5))
(let loop ((n (- n 2)) (rs (list 3 1)) (ss (list 4 2)))
|
view (15 lines, 1 line of output) |
; splay heaps
(define (range . args)
(case (length args)
((1) (range 0 (car args) (if (negative? (car args)) -1 1)))
|
view (150 lines, 3 lines of output) |
(define (string-join sep ss)
(define (f s ss)
(string-append s (string sep) ss))
(define (join ss)
(if (null? (cdr ss)) (car ss)
|
view (114 lines) |
; floating point rounding
(define (round f n)
(/ (truncate (+ (* f (expt 10 n)) 0.5)) (expt 10 n)))
|
view (10 lines, 5 lines of output) |
; happy new year
(define (mappend f . xss) (apply append (apply map f xss)))
(define (catenate ss) (apply string (mappend string->list ss)))
|
view (86 lines, 1 line of output) |
; three wise men
(define-syntax fold-of
(syntax-rules (range in is)
((_ "z" f b e) (set! b (f b e)))
|
view (38 lines, 1 line of output) |
; building primes
(define (filter pred? xs)
(let loop ((xs xs) (ys '()))
(cond ((null? xs) (reverse ys))
|
view (62 lines, 1 line of output) |
; the seven immortals
(define (immortals n)
(define (binom n k)
(let loop ((n n) (k k) (b 1))
|
view (21 lines, 162 lines of output) |
; 115132219018763992565095597973971522401
(define (digits n . args)
(let ((b (if (null? args) 10 (car args))))
(let loop ((n n) (d '()))
|
view (17 lines, 22 lines of output) |
; stepwise program development: a heuristic algorithm
(define-syntax while
(syntax-rules ()
((while pred? body ...)
|
view (71 lines, 449 lines of output) |
; selection, revisited
(define (split n xs)
(let loop ((n n) (xs xs) (zs '()))
(if (or (zero? n) (null? xs))
|
view (138 lines, 4 lines of output) |
; tonelli-shanks algorithm
(define (expm b e m)
(define (m* x y) (modulo (* x y) m))
(cond ((zero? e) 1)
|
view (62 lines, 3 lines of output) |
; list difference
(define (make-hash hash eql? oops size)
(let ((table (make-vector size '())))
(lambda (message . args)
|
view (107 lines, 6 lines of output) |
; list intersection and union
(define (make-hash hash eql? oops size)
(let ((table (make-vector size '())))
(lambda (message . args)
|
view (107 lines, 6 lines of output) |
; list intersection and union
(define (make-hash hash eql? oops size)
(let ((table (make-vector size '())))
(lambda (message . args)
|
view (131 lines, 6 lines of output) |
; gasoline mileage log
(define (display1 x)
(let ((x (inexact->exact (floor (* 10 x)))))
(display (quotient x 10))
|
view (24 lines) |
; pandigital numbers
(define (pandigital? . xs)
(let ((ds (make-vector 10 #f)))
(let x-loop ((xs xs))
|
view (39 lines, 2 lines of output) |
(define (pandigital? . xs)
(let ((ds (make-vector 10 #f)))1
(let x-loop ((xs xs))
(if (null? xs) #t
(let d-loop ((x (car xs)))
|
view (19 lines, 2 lines of output) |
; pythagorean triples
(define (euclid limit)
(define (trip m n)
(let ((m2 (* m m)) (n2 (* n n)))
|
view (44 lines, 4 lines of output) |
; universal hash function
(define (hash x)
(define (mod n) (modulo n 4294967296))
(cond ((boolean? x) (if x 1 0))
|
view (45 lines, 11 lines of output) |
; prime partitions
(define (prime-parts n)
(let ((sopf (make-vector (+ n 1) 0))
(kappa (make-vector (+ n 1) 0)))
|
view (22 lines, 2 lines of output) |
#! /usr/bin/scheme --script
; put, get, dir -- version control system
(define (read-line . port)
|
view (154 lines) |
; petals around the rose
(define rand #f)
(define randint #f)
(let ((two31 #x80000000) (a (make-vector 56 -1)) (fptr #f))
|
view (89 lines) |
; aks primality prover
(define (split n xs)
(let loop ((n n) (xs xs) (zs '()))
(if (or (zero? n) (null? xs))
|
view (130 lines, 2 lines of output) |
; aks primality prover, part 1
(define (split n xs)
(let loop ((n n) (xs xs) (zs '()))
(if (or (zero? n) (null? xs))
|
view (46 lines, 2 lines of output) |
; aks primality prover
(define (split n xs)
(let loop ((n n) (xs xs) (zs '()))
(if (or (zero? n) (null? xs))
|
view (140 lines, 2 lines of output) |
(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)))))
|
view (66 lines, 2 lines of output) |
(define (expm b e m)
(define (times x y) (modulo (* x y) m))
(let loop ((b b) (e e) (r 1))
(if (zero? e) r
(loop (times b b) (quotient e 2)
|
view (109 lines, 4 lines of output) |
; birthday paradox
(define rand #f)
(define randint #f)
(let ((two31 #x80000000) (a (make-vector 56 -1)) (fptr #f))
|
view (65 lines, 2 lines of output) |
; autumn equinox
(define (string-split sep str)
(define (f cs xs) (cons (list->string (reverse cs)) xs))
(let loop ((ss (string->list str)) (cs '()) (xs '()))
|
view (149 lines, 4 lines of output) |
; tribonacci numbers
(define (iterate n f . bs)
(let loop ((n n) (b (car bs)) (bs (cdr bs)) (xs '()))
(if (zero? n) (reverse xs)
|
view (78 lines, 3 lines of output) |
; the sum of the first billion primes
(define (last-pair xs)
(if (null? (cdr xs)) xs
(last-pair (cdr xs))))
|
view (184 lines, 11 lines of output) |
; fountain codes
(define (take n xs)
(let loop ((n n) (xs xs) (ys '()))
(if (or (zero? n) (null? xs))
|
view (142 lines, 1 line of output) |
; hash tables with open addressing
; knuth aocp3 sec 6.4 algo L and R
(define (filter pred? xs)
(let loop ((xs xs) (ys '()))
|
view (76 lines, 7 lines of output) |
; random-access lists
; empty, empty? -- equivalent to (list), null?
; O(1): kons, head, tail -- equivalent to cons, car, cdr
; O(log n): lookup, update! -- equivalent to O(n) list-ref, list-set!
; Chris Okasaki, Purely Functional Data Structures, Figure 9.7, page 134
|
view (148 lines, 4 lines of output) |
; hash tables with open addressing
(define (string-hash str)
(let loop ((cs (string->list str)) (s 0))
(if (null? cs) s
|
view (66 lines, 5 lines of output) |
; hash tables with open addressing
(define (string-hash str)
(let loop ((cs (string->list str)) (s 0))
(if (null? cs) s
|
view (52 lines) |
; two more random exercises
(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))
|
view (28 lines, 50 lines of output) |
; two random exercises
(define-syntax fold-of
(syntax-rules (range in is)
((_ "z" f b e) (set! b (f b e)))
|
view (128 lines, 2 lines of output) |
; 4sum
(define (cons* first . rest)
(let loop ((curr first) (rest rest))
(if (null? rest) curr
|
view (237 lines, 3 lines of output) |
; make
(define (string-split sep str)
(define (f cs xs) (cons (list->string (reverse cs)) xs))
(let loop ((ss (string->list str)) (cs '()) (xs '()))
|
view (72 lines) |
; once in a blue moon
(define (julian year month day)
(let* ((a (quotient (- 14 month) 12))
(y (+ year 4800 (- a)))
|
view (45 lines, 1 line of output) |
; send + more = money
(define (mappend f . xss) (apply append (apply map f xss)))
(define (make-list n x)
|
view (123 lines, 1 line of output) |
; infix expression evaluation
(define (filter pred? xs)
(let loop ((xs xs) (ys '()))
(cond ((null? xs) (reverse ys))
|
view (112 lines, 1 line of output) |
; breshenham's line-drawing algorithm
(define esc (integer->char 27))
(define (cls)
(display esc) (display #\[)
|
view (46 lines, 1 line of output) |
; zeckendorf representation
; reddit.com/r/dailyprogrammer challenge #74 easy
(define (fibs n)
(let loop ((f2 1) (f1 1) (f 2) (fs (list 1 1)))
|
view (18 lines, 3 lines of output) |
; sieving for totients
(define (totients n)
(let ((tots (make-vector (+ n 1))))
(do ((i 0 (+ i 1))) ((< n i))
|
view (14 lines, 1 line of output) |
; fractran
(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))
|
view (37 lines, 19 lines of output) |
; primes n -- list of primes not greater than n in ascending order
(define (primes n) ; assumes n is an integer greater than one
(let* ((len (quotient (- n 1) 2)) (bits (make-vector len #t)))
(let loop ((i 0) (p 3) (ps (list 2))) ; sieve of eratosthenes
(cond ((< n (* p p))
|
view (38 lines, 1 line of output) |
; chopping words
(define (range . args)
(case (length args)
((1) (range 0 (car args) (if (negative? (car args)) -1 1)))
|
view (58 lines) |
; unbounded spigots
(define-syntax define-generator
(lambda (x)
(syntax-case x (lambda)
|
view (53 lines, 2 lines of output) |
; counting ones
(define (filter pred? xs)
(let loop ((xs xs) (ys '()))
(cond ((null? xs) (reverse ys))
|
view (21 lines, 16 lines of output) |
; billboard challenge, part 1
(define (make-list n x)
(let loop ((n n) (xs '()))
(if (zero? n) xs
|
view (62 lines, 2 lines of output) |
(define (make-dict lt?)
; 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
|
view (271 lines, 5 lines of output) |
#! /usr/bin/scheme --script
(define (do-file file-name)
(let ((p (if (string=? file-name "-")
(current-input-port)
|
view (20 lines) |
; binomial heaps
(define node vector) ; rank item kids
(define (rank n) (vector-ref n 0))
(define (item n) (vector-ref n 1))
|
view (71 lines, 1 line of output) |
; square roots
(define (bisect n)
(let loop ((lo (if (< 1 n) 1. n)) (hi (if (< 1 n) n 1.)))
(display lo) (display " ") (display hi) (newline)
|
view (48 lines, 152 lines of output) |
; ackermann's function
(define (a m n)
(cond ((zero? m) (+ n 1))
((zero? n) (a (- m 1) 1))
|
view (8 lines, 1 line of output) |
; hamming codes
; http://www2.rad.com/networks/1994/err_con/hamming.htm
(define (make-matrix rows columns . value)
|
view (101 lines, 9 lines of output) |
; formatted numeric output
(define (digits n . args)
(let ((b (if (null? args) 10 (car args))))
(let loop ((n n) (d '()))
|
view (55 lines, 9 lines of output) |
; formatted numeric output
(define (digits n . args)
(let ((b (if (null? args) 10 (car args))))
(let loop ((n n) (d '()))
|
view (53 lines, 7 lines of output) |
; streaming knapsack
(define (make-hash hash eql? oops size)
(let ((table (make-vector size '())))
(lambda (message . args)
|
view (112 lines, 25 lines of output) |
; factor tables
(define (lpf-sieve n)
(let* ((len (quotient (- n 1) 2))
(lpf (make-vector len 1)))
|
view (63 lines, 85 lines of output) |
; legendre's symbol
(define (jacobi a m)
(if (not (integer? a)) (error 'jacobi "must be integer")
(if (not (and (integer? m) (positive? m) (odd? m)))
|
view (23 lines, 3 lines of output) |
; trabb pardo-knuth algorithm
(define (tpk len)
(define (f x) (+ (sqrt (abs x)) (* 5 x x x)))
(let loop ((len len) (nums '()))
|
view (40 lines) |
; even-odd partition
(define (even-odd vec)
(define (swap! a b)
(let ((t (vector-ref vec a)))
|
view (13 lines, 1 line of output) |
; rhyming dictionary
(define (read-line . port)
(define (eat p c)
(if (and (not (eof-object? (peek-char p)))
|
view (95 lines) |
; john horton conway's game of life
(define (make-matrix rows columns . value)
(do ((m (make-vector rows)) (i 0 (+ i 1)))
((= i rows) m)
|
view (130 lines) |
; twin primes
; primes n -- list of primes not greater than n in ascending order
(define (primes n) ; assumes n is an integer greater than one
(let* ((len (quotient (- n 1) 2)) (bits (make-vector len #t)))
|
view (45 lines, 2 lines of output) |
; twin primes
; primes n -- list of primes not greater than n in ascending order
(define (primes n) ; assumes n is an integer greater than one
(let* ((len (quotient (- n 1) 2)) (bits (make-vector len #t)))
|
view (46 lines, 2 lines of output) |
; twin primes
; primes n -- list of primes not greater than n in ascending order
(define (primes n) ; assumes n is an integer greater than one
(let* ((len (quotient (- n 1) 2)) (bits (make-vector len #t)))
|
view (50 lines, 2 lines of output) |
# programming with prime numbers
def primes(n):
if type(n) != int and type(n) != long:
raise TypeError('must be integer')
|
view (117 lines, 7 lines of output) |
# programming with prime numbers
def primes(n):
if type(n) != int and type(n) != long:
raise TypeError('must be integer')
|
view (114 lines, 7 lines of output) |
; galton
(define rand #f)
(define randint #f)
(let ((two31 #x80000000) (a (make-vector 56 -1)) (fptr #f))
|
view (74 lines, 8 lines of output) |
; voters
(define (make-matrix rows columns . value)
(do ((m (make-vector rows)) (i 0 (+ i 1)))
((= i rows) m)
|
view (125 lines) |
; cornacchia's algorithm
; primes n -- list of primes not greater than n in ascending order
(define (primes n) ; assumes n is an integer greater than one
(let* ((len (quotient (- n 1) 2)) (bits (make-vector len #t)))
|
view (175 lines, 3 lines of output) |
; programming with prime numbers
(define (primes n)
(if (or (not (integer? n)) (< n 2))
(error 'primes "must be integer greater than one")
|
view (107 lines, 7 lines of output) |
/* prime.c -- programming with prime numbers
* compile as: gcc -O3 prime.c -o prime
* run as: ./prime */
#include <stdio.h>
|
view (188 lines, 4 lines of output) |
/* prime.c -- programming with prime numbers
* compile as: gcc -O3 prime.c -lgmp -o prime
* run as: ./prime */
#include <stdio.h>
|
view (388 lines) |
; subset sum, meet in the middle
(define (make-hash hash eql? oops size)
(let ((table (make-vector size '())))
(lambda (message . args)
|
view (96 lines, 4 lines of output) |
; subset sum
(define (make-hash hash eql? oops size)
(let ((table (make-vector size '())))
(lambda (message . args)
(if (eq? message 'enlist)
|
view (58 lines, 1 line of output) |
; base-26 arithmetic
(define (digits n . args)
(let ((b (if (null? args) 10 (car args))))
(let loop ((n n) (d '()))
|
view (32 lines, 3 lines of output) |
-- programming with prime numbers
import Control.Monad (forM_, when)
import Control.Monad.ST
import Data.Array.ST
|
view (98 lines) |
-- programming with prime numbers
import Control.Monad (forM_, when)
import Control.Monad.ST
import Data.Array.ST
|
view (98 lines) |
-- programming with prime numbers
import Control.Monad (forM_, when)
import Control.Monad.ST
import Data.Array.ST
|
view (98 lines, 2 lines of output) |
; factoring multiple rsa keys
(define-syntax fold-of
(syntax-rules (range in is)
((_ "z" f b e) (set! b (f b e)))
|
view (203 lines, 2 lines of output) |
; sum of squares of two largest of three values
(define-syntax assert
(syntax-rules ()
((assert expr result)
|
view (55 lines, 7 lines of output) |
-- programming with prime numbers
import Control.Monad (forM_, when)
import Control.Monad.ST
import Data.Array.ST
|
view (90 lines, 2 lines of output) |
-- programming with prime numbers
import Control.Monad (forM_, when)
import Control.Monad.ST
import Data.Array.ST
|
view (90 lines, 2 lines of output) |
/* prime.c -- programming with prime numbers
* compile as: gcc -O3 prime.c -lgmp -o prime
* run as: ./prime */
#include <stdio.h>
|
view (407 lines) |
; union route cipher
(define (take n xs)
(let loop ((n n) (xs xs) (ys '()))
(if (or (zero? n) (null? xs))
|
view (160 lines, 2 lines of output) |
; balanced delimiters
(define (balanced? str) ; () [] {} <> '' "" escape with \
(let ((delims '((#\( . #\)) (#\[ . #\]) (#\{ . #\}) (#\< . #\>))))
(let loop ((cs (string->list str)) (stack (list)) (single? #f) (double? #f))
|
view (32 lines, 2 lines of output) |
; next greater permutation of digits
(define (digits n . args)
(let ((b (if (null? args) 10 (car args))))
(let loop ((n n) (d '()))
|
view (40 lines, 2 lines of output) |
/* prime.c -- programming with prime numbers
* compile as: gcc -lgmp -o prime prime.c
* run as: ./prime */
#include <stdio.h>
|
view (388 lines) |
; remove characters from a string
(define (string-index c str)
(let loop ((ss (string->list str)) (k 0))
(cond ((null? ss) #f)
|
view (51 lines, 3 lines of output) |
/* prime.c -- programming with prime numbers
* compile as: gcc -lgmp -o prime prime.c
* run as: ./prime -- takes no input */
#include <stdio.h>
|
view (377 lines) |
(define (divisors n)
(let ((divs (make-vector (+ n 1) (list)))
(cnts (make-vector (+ n 1) 0))
(sums (make-vector (+ n 1) 0)))
(do ((i 1 (+ i 1))) ((<= n i) (values divs cnts sums))
|
view (45 lines, 6 lines of output) |
(define (divisors n)
(let ((divs (make-vector (+ n 1) (list)))
(cnts (make-vector (+ n 1) 0))
(sums (make-vector (+ n 1) 0)))
(do ((i 1 (+ i 1))) ((<= n i) (values divs cnts sums))
|
view (45 lines, 4 lines of output) |
(define (divisors n)
(let ((divs (make-vector (+ n 1) (list)))
(cnts (make-vector (+ n 1) 0))
(sums (make-vector (+ n 1) 0)))
(do ((i 1 (+ i 1))) ((<= n i) (values divs cnts sums))
|
view (45 lines, 2 lines of output) |
; search in an ascending matrix
(define (matrix-rows x) (vector-length x))
(define (matrix-cols x) (vector-length (vector-ref x 0)))
|
view (25 lines, 3 lines of output) |
; solar compass
(define (julian year month day)
(let* ((a (quotient (- 14 month) 12))
(y (+ year 4800 (- a)))
|
view (81 lines, 2 lines of output) |
# prime.py -- modest prime number library
def primes(n):
"""
list of primes not exceeding n in ascending
|
view (100 lines, 6 lines of output) |
# prime.py -- modest prime number library
def primes(n):
"""
list of primes not exceeding n in ascending
|
view (98 lines, 4 lines of output) |
# prime.py -- modest prime number library
def primes(n):
"""
list of primes not exceeding n in ascending
|
view (84 lines, 3 lines of output) |
; string rotation
(define (string-find pat str . s)
(let* ((plen (string-length pat))
(slen (string-length str))
|
view (30 lines, 3 lines of output) |
; anagram phrases
(define (remove x xs)
(let loop ((xs xs) (zs '()))
(cond ((null? xs) (reverse zs))
|
view (83 lines) |
; roman numeral puzzle
; http://www.johndcook.com/blog/2012/01/14/roman-numeral-puzzle/
(define (range . args)
(case (length args)
|
view (104 lines, 1 line of output) |
; knights on a keypad
(define (sum xs) (apply + xs))
(define (count n from) ; recursive solution
|
view (36 lines, 4 lines of output) |
; guess the number
(define rand #f)
(define randint #f)
(let ((two31 #x80000000) (a (make-vector 56 -1)) (fptr #f))
|
view (112 lines, 5 lines of output) |
; excel's xirr function
(define (julian year month day)
(let* ((a (quotient (- 14 month) 12))
(y (+ year 4800 (- a)))
|
view (57 lines, 3 lines of output) |
; thirteen anagram
(define-syntax fold-of
(syntax-rules (range in is)
((_ "z" f b e) (set! b (f b e)))
|
view (184 lines, 2 lines of output) |
; modular square root with non-prime modulus
(define (expm b e m)
(define (m* x y) (modulo (* x y) m))
(cond ((zero? e) 1)
|
view (142 lines, 2 lines of output) |
; modular square root with non-prime modulus
(define (expm b e m)
(define (m* x y) (modulo (* x y) m))
(cond ((zero? e) 1)
|
view (146 lines, 2 lines of output) |
; pritchard's wheel sieve
(define (isqrt n)
(if (not (and (positive? n) (integer? n)))
(error 'isqrt "must be positive integer")
|
view (79 lines, 2 lines of output) |
; turtle graphics
(define xpos 0) (define ypos 0) (define pen? #t) (define head 0)
(define (send x . xs)
|
view (66 lines, 748 lines of output) |
; cheating hangman
(define (filter pred? xs)
(let loop ((xs xs) (ys '()))
(cond ((null? xs) (reverse ys))
|
view (210 lines) |
; koch snowflake
(define (replace xs old new)
(let loop ((xs xs) (zs (list)))
(cond ((null? xs) (reverse zs))
|
view (35 lines, 3591 lines of output) |
; hangman
(define (filter pred? xs)
(let loop ((xs xs) (ys '()))
(cond ((null? xs) (reverse ys))
|
view (185 lines) |
; majority voting
(define rand #f)
(define randint #f)
(let ((two31 #x80000000) (a (make-vector 56 -1)) (fptr #f))
|
view (118 lines, 9 lines of output) |
; split
(define (split xs)
(let loop ((ts xs) (hs xs) (zs (list)))
(if (or (null? hs) (null? (cdr hs)))
|
view (21 lines, 18 lines of output) |
; validating telephone numbers
(define (drop-while pred? xs)
(let loop ((xs xs))
(if (or (null? xs) (not (pred? (car xs)))) xs
|
view (103 lines) |
; mcnugget numbers
(define (range . args)
(case (length args)
((1) (range 0 (car args) (if (negative? (car args)) -1 1)))
|
view (93 lines, 1 line of output) |
; knight rider
; Given a chessboard, find a path of knight jumps visiting all fields of the
; board. A normal chessboard has 8 rows and 8 columns. Generalize the
; knight rider such as to acccept a square board of arbitrary size.
|
view (168 lines, 1 line of output) |
; sieve of eratosthenes
(define (primes . args) ; (primes [lo] hi) inclusive at both ends
(let* ((lo (if (null? (cdr args)) 0 (car args)))
(hi (if (null? (cdr args)) (car args) (cadr args))))
|
view (57 lines, 9 lines of output) |
; avl trees
(define (tree k v l r)
(vector k v l r (+ (max (ht l) (ht r)) 1)
(+ (size l) (size r) 1)))
|
view (140 lines, 11 lines of output) |
; avl trees
(define (tree k v l r)
(vector k v l r (+ (max (ht l) (ht r)) 1)))
(define (key t) (vector-ref t 0))
|
view (219 lines, 15 lines of output) |
; avl trees
(define (tree k v l r) (vector k v l r (+ (max (ht l) (ht r)) 1)))
(define (key t) (vector-ref t 0))
(define (val t) (vector-ref t 1))
|
view (91 lines, 4 lines of output) |
; pascal's triangle
(define (string-join sep ss)
(define (f s ss)
(string-append s (string sep) ss))
|
view (38 lines, 11 lines of output) |
; rabin's cryptosystem
(define (split n xs)
(let loop ((n n) (xs xs) (zs '()))
(if (or (zero? n) (null? xs))
|
view (218 lines, 1 line of output) |
; grade school multiplication
(define (filter pred? xs)
(let loop ((xs xs) (ys '()))
(cond ((null? xs) (reverse ys))
|
view (58 lines, 22 lines of output) |
; phil harvey's puzzle
(define (range . args)
(case (length args)
((1) (range 0 (car args) (if (negative? (car args)) -1 1)))
|
view (42 lines, 2 lines of output) |
(define (primes . args) ; (primes [lo] hi) inclusive at both ends
(let* ((lo (if (null? (cdr args)) 0 (car args)))
(hi (if (null? (cdr args)) (car args) (cadr args))))
(cond ((and (<= lo 100000) (<= hi 1000000)) ; simple sieve
(let* ((max-index (quotient (- hi 3) 2))
|
view (363 lines) |
; craps
(define (filter pred? xs)
(let loop ((xs xs) (ys '()))
(cond ((null? xs) (reverse ys))
|
view (125 lines, 4 lines of output) |
-- Sieve of Eratosthenes
-- Melissa O'Neill "The Genuine Sieve of Eratosthenes"
-- http://www.cs.hmc.edu/~oneill/papers/Sieve-JFP.pdf
-- priority queue from http://hpaste.org/report/1447
|
view (84 lines, 2 lines of output) |
-- Sieve of Eratosthenes
-- Melissa O'Neill "The Genuine Sieve of Eratosthenes"
-- http://www.cs.hmc.edu/~oneill/papers/Sieve-JFP.pdf
-- priority queue from http://hpaste.org/report/1447
|
view (81 lines, 2 lines of output) |
; crypt
(define (crypt key infile outfile)
(define (last-pair xs) (if (null? (cdr xs)) xs (last-pair (cdr xs))))
(define (cycle xs) (set-cdr! (last-pair xs) xs) xs)
|
view (11 lines) |
#! /usr/bin/scheme --script
(define cksum
(let* ((two32 4294967296)
(crctab (vector #x00000000
|
view (78 lines) |
#! /usr/bin/scheme --script
(define (getopt defn msg args) ; => (values (list opt/arg ...) (list file ...))
(define (parse-options defn)
(let loop ((options (string->list defn)) (lones '()) (args '()))
|
view (73 lines) |
; the wall
(define (get parm)
(display (case parm
((composition) "Enter type of wall in quotes (for instance, \"Lava Rock\" or \"Brick\")")
|
view (69 lines) |
; the wall
(define (get parm)
(display (case parm
((composition) "Enter type of wall in quotes (for instance, \"Lava Rock\" or \"Brick\")")
|
view (74 lines) |
(define temp-list (list '398 '150 '1.15 '2875 '-900 '1565 '800 '230 '200 '0 '0 '0))
(define b
(let loop ((xs temp-list) (zs '()))
(if (null? (cdr xs))
|
view (9 lines, 1 line of output) |
; the first n primes
(define-syntax pq-rank (syntax-rules () ((_ pq) (vector-ref pq 0))))
(define-syntax pq-item (syntax-rules () ((_ pq) (vector-ref pq 1))))
(define-syntax pq-lkid (syntax-rules () ((_ pq) (vector-ref pq 2))))
|
view (61 lines, 1 line of output, 114 comments) |
; sieve of sundaram
(define (range . args)
(case (length args)
((1) (range 0 (car args) (if (negative? (car args)) -1 1)))
|
view (184 lines, 5 lines of output) |
; brainfuck
(define (filter pred? xs)
(let loop ((xs xs) (ys '()))
(cond ((null? xs) (reverse ys))
|
view (90 lines, 524 lines of output) |
; sieve of sundaram
(define (primes n)
(let* ((m (quotient n 2)) (pv (make-vector (+ m 1) #t)))
(do ((i 1 (+ i 1))) ((< (quotient m 4) i))
|
view (140 lines, 4 lines of output) |
; logarithm tables
(define (range . args)
(case (length args)
((1) (range 0 (car args) (if (negative? (car args)) -1 1)))
|
view (108 lines, 207 lines of output) |
; logarithm table
; http://www.oldcomputers.arcula.co.uk/bhist3.htm
(define (range . args)
(case (length args)
|
view (109 lines, 207 lines of output) |
; array duplicates
(define rand #f)
(define randint #f)
(let ((two31 #x80000000) (a (make-vector 56 -1)) (fptr #f))
|
view (154 lines, 6 lines of output) |
; project euler problem 3
(define (factors n) ; trial division
(let loop ((n n) (fs '()))
(if (even? n) (loop (/ n 2) (cons 2 fs))
|
view (12 lines, 1 line of output) |
; pollard's p-1 factorization algorithm, revisited
(define (expm b e m)
(define (m* x y) (modulo (* x y) m))
(cond ((zero? e) 1)
|
view (151 lines, 4 lines of output) |
; project euler 12
(define (factors n)
(if (even? n) (cons 2 (factors (/ n 2)))
(let loop ((n n) (f 3) (fs '()))
|
view (22 lines, 2 lines of output) |
; mersenne twister
(define (logand a b)
(if (or (zero? a) (zero? b)) 0
(+ (* (logand (floor (/ a 2)) (floor (/ b 2))) 2)
|
view (91 lines, 125 lines of output) |
/* A C-program for MT19937: Integer version (1998/4/6) */
/* genrand() generates one pseudorandom unsigned integer (32bit) */
/* which is uniformly distributed among 0 to 2^32-1 for each */
/* call. sgenrand(seed) set initial values to the working area */
/* of 624 words. Before genrand(), sgenrand(seed) must be */
|
view (93 lines, 128 lines of output) |
; deques
(define (split n xs)
(let loop ((n n) (xs xs) (zs (list)))
(if (or (zero? n) (null? xs))
|
view (98 lines) |
; two string exercises
; remove duplicate characters from a string
(define (rem-dup-char str)
(let ((seen (make-vector 256 #f)))
|
view (28 lines, 4 lines of output) |
; hamming numbers
(define (hamming n)
(let ((aq (make-vector (+ n 1) 0))
(i2 1) (i3 1) (i5 1) (x2 2) (x3 3) (x5 5))
|
view (31 lines, 1002 lines of output) |
; reverse every k nodes of a linked list
(define (take n xs)
(let loop ((n n) (xs xs) (ys '()))
(if (or (zero? n) (null? xs))
|
view (23 lines, 5 lines of output) |
; knapsack
(define (make-matrix rows columns . value)
(do ((m (make-vector rows)) (i 0 (+ i 1)))
((= i rows) m)
|
view (53 lines, 2 lines of output) |
; first non-repeating character
(define (first-non-rep-char str)
(let ((freq (make-vector 256 0)))
(do ((j 0 (+ j 1))) ((= j (string-length str)))
|
view (14 lines, 1 line of output) |
; insert into a sorted cyclic list
(define (last-pair xs)
(if (null? (cdr xs)) xs
(last-pair (cdr xs))))
|
view (30 lines, 9 lines of output) |
; word breaks
(define (make-hash hash eql? oops size)
(let ((table (make-vector size '())))
(lambda (message . args)
|
view (86 lines, 6 lines of output) |
; ninety-nine bottles of beer
(define (num->words n)
(letrec ((ones '("" "one" "two" "three" "four" "five" "six"
"seven" "eight" "nine" "ten" "eleven" "twelve"
|
view (78 lines, 494 lines of output) |
; approximating pi
(define (logint x)
(let ((gamma 0.57721566490153286061) (log-x (log x)))
(let loop ((k 1) (fact 1) (num log-x)
|
view (57 lines, 4 lines of output) |
; the nth prime
(define (make-hash hash eql? oops size)
(let ((table (make-vector size '())))
(lambda (message . args)
|
view (220 lines, 2 lines of output) |
; more prime-counting functions
(define (make-hash hash eql? oops size)
(let ((table (make-vector size '())))
(lambda (message . args)
|
view (139 lines, 6 lines of output) |
(define (make-hash hash eql? oops size)
(let ((table (make-vector size '())))
(lambda (message . args)
(if (eq? message 'enlist)
(let loop ((k 0) (result '()))
|
view (93 lines, 1 line of output) |
; sum of two integers
(define (make-hash hash eql? oops size)
(let ((table (make-vector size '())))
(lambda (message . args)
|
view (142 lines, 6 lines of output) |
; json
; http://json.org for details of json syntax and semantics
; (read-json [port]) reads the next json object on port,
|
view (220 lines) |
; json: parsing input
(define json-null (string->symbol "the-json-null-object"))
(define (json-null? obj) (eqv? json-null obj))
|
view (170 lines) |
; vedic divisibility
(define (digits n . args)
(let ((b (if (null? args) 10 (car args))))
(let loop ((n n) (d '()))
|
view (39 lines, 3 lines of output) |
; big numbers
; Represented as a list with the car containing the signed logarithm of the
; number to the internal base followed in the cdr by the unsigned digits to
; the internal base, with the least significant digit first. Thus, zero is
|
view (391 lines, 54 lines of output) |
; feet and inches
(define (feet-and-inches n)
(if (zero? n) "0 feet 0 inches"
(let* ((n (+ n 1/64))
|
view (24 lines, 13 lines of output) |
; big numbers
; Represented as a list with the car containing the signed logarithm of the
; number to the internal base followed in the cdr by the unsigned digits to
; the internal base, with the least significant digit first. Thus, zero is
|
view (302 lines) |
; big numbers
; Represented as a list with the car containing the signed logarithm of the
; number to the internal base followed in the cdr by the unsigned digits to
; the internal base, with the least significant digit first. Thus, zero is
|
view (335 lines) |
; big numbers: input and output
(define (take n xs)
(let loop ((n n) (xs xs) (ys '()))
(if (or (zero? n) (null? xs))
|
view (311 lines, 1 line of output) |
; steganography
(define (take n xs)
(let loop ((n n) (xs xs) (ys '()))
(if (or (zero? n) (null? xs))
|
view (260 lines) |
; big numbers: division
(define (take n xs)
(let loop ((n n) (xs xs) (ys '()))
(if (or (zero? n) (null? xs))
|
view (281 lines, 14 lines of output) |
; big numbers: division
(define (take n xs)
(let loop ((n n) (xs xs) (ys '()))
(if (or (zero? n) (null? xs))
|
view (281 lines, 8 lines of output) |
; big numbers: division
(define (take n xs)
(let loop ((n n) (xs xs) (ys '()))
(if (or (zero? n) (null? xs))
|
view (281 lines, 2 lines of output) |
; big numbers: addition, subtraction and multiplication
(define big-base 1000)
(define (integer->big int)
|
view (157 lines, 3 lines of output) |
; mersenne primes
(define (range . args)
(case (length args)
((1) (range 0 (car args) (if (negative? (car args)) -1 1)))
|
view (84 lines, 1 line of output) |
; upside up
(define (range . args)
(case (length args)
((1) (range 0 (car args) (if (negative? (car args)) -1 1)))
|
view (49 lines, 2 lines of output) |
; isbn validation
(define (drop n xs)
(let loop ((n n) (xs xs))
(if (or (zero? n) (null? xs)) xs
|
view (109 lines) |
; two bad sorts
(define rand #f)
(define randint #f)
(let ((two31 #x80000000) (a (make-vector 56 -1)) (fptr #f))
|
view (83 lines, 2 lines of output) |
; dixon's factorization algorithm
(define (cons* first . rest)
(let loop ((curr first) (rest rest))
(if (null? rest) curr
|
view (179 lines) |
; dixon's factorization algorithm
(define (last-pair xs)
(if (null? (cdr xs)) xs
(last-pair (cdr xs))))
|
view (166 lines, 1 line of output) |
#! /usr/bin/scheme --script
(define (read-line . port)
(define (eat p c)
(if (and (not (eof-object? (peek-char p)))
|
view (68 lines) |
; entab and detab
(define (detab n file-name)
(with-input-from-file file-name
(lambda ()
|
view (39 lines) |
; rule 30 rng
(define (cycle xs) (set-cdr! (last-pair xs) xs) xs)
(define (last-pair xs)
|
view (80 lines, 52 lines of output) |
; rule 30 rng
(define (cycle xs) (set-cdr! (last-pair xs) xs) xs)
(define (last-pair xs)
|
view (76 lines, 51 lines of output) |
; house of representatives
(define-syntax (define-structure x)
(define (gen-id template-id . args)
(datum->syntax-object template-id
|
view (119 lines) |
; house of representatives
(define-syntax (define-structure x)
(define (gen-id template-id . args)
(datum->syntax-object template-id
|
view (121 lines) |
; partition numbers
(define (partition n) ; naive version
(if (negative? n) 0
(if (zero? n) 1
|
view (33 lines, 4 lines of output) |
(define partition
(let ((len 1) (pv (vector 1)))
(define (grow)
(let* ((new-len (+ len len))
(new-pv (make-vector new-len #f)))
|
view (25 lines, 2 lines of output) |
#! /usr/bin/scheme --script
(define (filter pred? xs)
(let loop ((xs xs) (ys '()))
(cond ((null? xs) (reverse ys))
|
view (88 lines) |
; squaring the bishop
; based on ftp://ftp.fourmilab.ch/pub/babbage/Osqbish.html
(define (read-line . port)
(define (eat p c)
|
view (88 lines) |
; xref
(define (char-in-ident? c) ; scheme identifiers
(or (char-alphabetic? c) (char-numeric? c)
(member c (string->list "?!.+-*/<=>:$%^&_~@"))))
|
view (37 lines) |
; xref
(define (char-in-ident? c) ; scheme identifiers
(or (char-alphabetic? c) (char-numeric? c)
(member c (string->list "?!.+-*/<=>:$%^&_~@"))))
|
view (37 lines) |
; credit card validation
(define (digits n . args)
(let ((b (if (null? args) 10 (car args))))
(let loop ((n n) (d '()))
|
view (114 lines, 2 lines of output) |
; maximum difference in an array
(define (range . args)
(case (length args)
((1) (range 0 (car args) (if (negative? (car args)) -1 1)))
|
view (117 lines) |
; look and say, revisited
(define cs '(-6 3 -6 12 -4 7 -7 1 0 5 -2 -4 -12 2 7
12 -7 -10 -4 3 9 -7 0 -8 14 -3 9 2 -3 -10 -2 -6 1
10 -3 1 7 -7 7 -12 -5 8 6 10 -8 -8 -7 -3 9 1 6 6 -2
|
view (23 lines, 1 line of output) |
#! /usr/bin/scheme --script
(define (sum)
(let loop ((c (read-char)) (s 0) (b 0))
(if (eof-object? c)
|
view (18 lines) |
; same five digits
(define-syntax fold-of
(syntax-rules (range in is)
((_ "z" f b e) (set! b (f b e)))
|
view (96 lines, 7 lines of output) |
; same five digits
(define-syntax fold-of
(syntax-rules (range in is)
((_ "z" f b e) (set! b (f b e)))
|
view (95 lines, 7 lines of output) |
; same five digits
(define-syntax fold-of
(syntax-rules (range in is)
((_ "z" f b e) (set! b (f b e)))
|
view (98 lines, 8 lines of output) |
; same five digits
(define-syntax fold-of
(syntax-rules (range in is)
((_ "z" f b e) (set! b (f b e)))
|
view (96 lines, 7 lines of output) |
; same five digits
(define-syntax fold-of
(syntax-rules (range in is)
((_ "z" f b e) (set! b (f b e)))
|
view (95 lines, 7 lines of output) |
; two kaprekar exercises
(define (take n xs)
(let loop ((n n) (xs xs) (ys '()))
(if (or (zero? n) (null? xs))
|
view (103 lines, 4 lines of output) |
; loopy loops
(define (range . args)
(case (length args)
((1) (range 0 (car args) (if (negative? (car args)) -1 1)))
|
view (53 lines, 61 lines of output) |
; loopy loops
(define (range . args)
(case (length args)
((1) (range 0 (car args) (if (negative? (car args)) -1 1)))
|
view (51 lines, 61 lines of output) |
; reverse words
(define (string-reverse! s lo hi)
(let loop ((lo lo) (hi (- hi 1)))
(if (< hi lo) s
|
view (29 lines, 9 lines of output) |
; chutes and ladders
(define rand #f)
(define randint #f)
(let ((two31 #x80000000) (a (make-vector 56 -1)) (fptr #f))
|
view (116 lines, 5 lines of output) |
; lowest common ancestor
(define (tree k l r) (vector k l r))
(define (key t) (vector-ref t 0))
(define (lkid t) (vector-ref t 1))
|
view (43 lines, 5 lines of output) |
(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)))))
|
view (7 lines, 1 line of output) |
; look and say
(define (iterate n f . bs)
(let loop ((n n) (b (car bs)) (bs (cdr bs)) (xs '()))
(if (zero? n) (reverse xs)
|
view (43 lines, 1 line of output) |
; sieve of euler
(define (primes n) ; sieve of eratosthenes
(let* ((max-index (quotient (- n 3) 2))
(v (make-vector (+ 1 max-index) #t)))
|
view (57 lines, 4 lines of output) |
; sieve of euler
(define (primes n) ; sieve of eratosthenes
(let* ((max-index (quotient (- n 3) 2))
(v (make-vector (+ 1 max-index) #t)))
|
view (56 lines, 3 lines of output) |
; sieve of euler
(define (primes n) ; sieve of eratosthenes
(let* ((max-index (quotient (- n 3) 2))
(v (make-vector (+ 1 max-index) #t)))
|
view (57 lines, 2 lines of output) |
; sliding window minimum
(define (take n xs)
(let loop ((n n) (xs xs) (ys '()))
(if (or (zero? n) (null? xs))
|
view (128 lines, 2 lines of output) |
; home primes
(define (digits n . args)
(let ((b (if (null? args) 10 (car args))))
(let loop ((n n) (d '()))
|
view (172 lines, 20 lines of output) |
; home primes
(define (digits n . args)
(let ((b (if (null? args) 10 (car args))))
(let loop ((n n) (d '()))
|
view (119 lines, 2 lines of output) |
; sums of powers
(define (range . args)
(case (length args)
((1) (range 0 (car args) (if (negative? (car args)) -1 1)))
|
view (51 lines, 4 lines of output) |
; the first computer program
(define (but-last xs)
(let loop ((xs xs) (zs '()))
(if (null? (cdr xs)) (reverse zs)
|
view (19 lines, 1 line of output) |
; the first computer program
(define (but-last xs)
(let loop ((xs xs) (zs '()))
(if (null? (cdr xs)) (reverse zs)
|
view (21 lines, 1 line of output) |
; google code jam qualification round africa 2010
(define (store-credit c l)
(define (s i j)
(+ (vector-ref l i)
|
view (61 lines, 10 lines of output) |
; cuckoo hashing
(define (prime? n) ; baillie-wagstaff
(define (expm b e m)
(define (times x y) (modulo (* x y) m))
|
view (177 lines) |
; population count
(define (ash int cnt)
(if (negative? cnt)
(let ((n (expt 2 (- cnt))))
|
view (49 lines, 8 lines of output) |
; rational numbers
(define (frac n d)
(if (zero? d) (error 'frac "can't have zero denominator")
(if (negative? d) (frac (- n) (- d))
|
view (34 lines, 5 lines of output) |
; pollard rho, revisited
(define (cons* first . rest)
(let loop ((curr first) (rest rest))
(if (null? rest) curr
|
view (167 lines, 198 lines of output) |
; solitaire cipher
(define (take n xs)
(let loop ((n n) (xs xs) (ys '()))
(if (or (zero? n) (null? xs))
|
view (240 lines, 3 lines of output) |
; slots
(define rand #f)
(define randint #f)
(let ((two31 #x80000000) (a (make-vector 56 -1)) (fptr #f))
|
view (106 lines) |
; slots
(define rand #f)
(define randint #f)
(let ((two31 #x80000000) (a (make-vector 56 -1)) (fptr #f))
|
view (106 lines) |
; rational numbers
(define (frac n d)
(if (zero? d) (error 'frac "can't have zero denominator")
(if (negative? d) (frac (- n) (- d))
|
view (34 lines, 5 lines of output) |
; counting primes
(define (isqrt n)
(if (not (and (positive? n) (integer? n)))
(error 'isqrt "must be positive integer")
|
view (88 lines) |
; two integrals
(define (exp-integral x)
(let* ((gamma 0.5772156649015328606065))
(let loop ((k 1) (fact 1) (z x) (sum (+ gamma (log x))))
|
view (24 lines, 3 lines of output) |
; carmichael numbers
(define (expm b e m)
(define (m* x y) (modulo (* x y) m))
(cond ((zero? e) 1)
|
view (103 lines, 8 lines of output) |
; interval arithmetic
(define (plus x y)
(cons (+ (car x) (car y)) (+ (cdr x) (cdr y))))
|
view (38 lines, 7 lines of output) |
; polite numbers
(define (range . args)
(case (length args)
((1) (range 0 (car args) (if (negative? (car args)) -1 1)))
|
view (98 lines, 3 lines of output) |
; two random selections
(define rand #f)
(define randint #f)
(let ((two31 #x80000000) (a (make-vector 56 -1)) (fptr #f))
|
view (66 lines, 2 lines of output) |
; form letters
(define (read-file file-name)
(with-input-from-file file-name (lambda ()
(let loop ((c (read-char)) (cs '()))
|
view (97 lines) |
; ullman's puzzle
(define (take n xs)
(let loop ((n n) (xs xs) (ys '()))
(if (or (zero? n) (null? xs))
|
view (98 lines, 1 line of output) |
; maximum sum subsequence
(define (max-sum-subseq-1 xv)
(let ((n (vector-length xv)) (max-so-far 0))
(do ((i 0 (+ i 1))) ((= i n) max-so-far)
|
view (75 lines, 6 lines of output) |
; divisors and totients
(define (range . args)
(case (length args)
((1) (range 0 (car args) (if (negative? (car args)) -1 1)))
|
view (96 lines, 5 lines of output) |
; arithmetic drill
(define rand #f)
(define randint #f)
(let ((two31 #x80000000) (a (make-vector 56 -1)) (fptr #f))
|
view (65 lines) |
(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)))))
|
view (11 lines, 1 line of output) |
; string subsets
(define (make-hash hash eql? oops size)
(let ((table (make-vector size '())))
(lambda (message . args)
|
view (191 lines, 5 lines of output) |
; topological sort
(define (filter pred? xs)
(let loop ((xs xs) (ys '()))
(cond ((null? xs) (reverse ys))
|
view (84 lines, 3 lines of output) |
; rsa cryptography
(define (digits n . args)
(let ((b (if (null? args) 10 (car args))))
(let loop ((n n) (d '()))
|
view (190 lines, 5 lines of output) |
; rowland's prime-generating function
(define (A106108 limit) ; initial sequence
(let loop ((n 1) (as '(7)))
(if (<= limit n) (reverse as)
|
view (38 lines, 4 lines of output) |
; chinese remainder theorem
(define (euclid x y)
(let loop ((a 1) (b 0) (g x) (u 0) (v 1) (w y))
(if (zero? w) (values a b g)
|
view (23 lines, 1 line of output) |
; subset sums
(define (filter pred? xs)
(let loop ((xs xs) (ys '()))
(cond ((null? xs) (reverse ys))
|
view (137 lines, 6 lines of output) |
; weather forecast
(define (tempname)
(let loop ((i 0))
(let ((f (string-append "temp" (number->string i))))
|
view (30 lines) |
; emirps
(define (take-while pred? xs)
(let loop ((xs xs) (ys '()))
(if (or (null? xs) (not (pred? (car xs))))
|
view (189 lines, 3 lines of output) |
; emirps
(define-syntax fold-of
(syntax-rules (range in is)
((_ "z" f b e) (set! b (f b e)))
|
view (115 lines, 1 line of output) |
; fibonacci primes
(define (greplin2 n)
(let loop ((f-2 0) (f-1 1) (f 1))
(if (and (< n f) (prime? f))
|
view (49 lines, 1 line of output) |
; benford's law
(define (read-csv-record . args)
(define (read-csv delim port)
(define (add-field field fields)
|
view (151 lines, 1 line of output) |
; text file databases: part 2
(define (fold-port reader folder base . port)
(let ((p (if (null? port) (current-input-port) (car port))))
(let loop ((item (reader p)) (result base))
|
view (28 lines) |
(define (read-fixed-record size defs . port)
(let ((p (if (null? port) (current-input-port) (car port))))
(let ((fix-rec (read-chars size p)))
(if (eof-object? fix-rec)
fix-rec
|
view (158 lines) |
; find the longest palindrome in a string
(define (range . args)
(case (length args)
((1) (range 0 (car args) (if (negative? (car args)) -1 1)))
|
view (90 lines, 1 line of output) |
; zeller's congruence
(define (julian year month day)
(let* ((a (quotient (- 14 month) 12))
(y (+ year 4800 (- a)))
|
view (56 lines, 1 line of output) |
; maxiphobic heaps
(define mh-node vector) ; size item lkid rkid
(define-syntax mh-size (syntax-rules () ((_ mh) (vector-ref mh 0))))
|
view (57 lines, 1 line of output) |
; oban numbers
(define-syntax fold-of
(syntax-rules (range in is)
((_ "z" f b e) (set! b (f b e)))
|
view (85 lines, 454 lines of output) |
; oban words
(define-syntax fold-of
(syntax-rules (range in is)
((_ "z" f b e) (set! b (f b e)))
|
view (85 lines, 454 lines of output) |
; alien numbers
(define (digits n . args)
(let ((b (if (null? args) 10 (car args))))
(let loop ((n n) (d '()))
|
view (72 lines, 4 lines of output) |
; kaprekar numbers
(define-syntax fold-of
(syntax-rules (range in is)
((_ "z" f b e) (set! b (f b e)))
|
view (49 lines, 1 line of output) |
; the factorization of f7
(define (cons* first . rest)
(let loop ((curr first) (rest rest))
(if (null? rest) curr
|
view (168 lines) |
; the factorization of f7, part 1
(define (cons* first . rest)
(let loop ((curr first) (rest rest))
(if (null? rest) curr
|
view (89 lines, 9 lines of output) |
; the factorization of f7, part 1
(define (cons* first . rest)
(let loop ((curr first) (rest rest))
(if (null? rest) curr
|
view (82 lines, 7 lines of output) |
#! /usr/bin/scheme --script
; data encryption standard
(define (getopt defn msg args) ; => (values (list opt/arg ...) (list file ...))
|
view (413 lines) |
; data encryption standard
(define (vector-map proc . vecs)
(define (elt i)
(lambda (vec)
|
view (450 lines, 2 lines of output) |
; data encryption standard
(define (vector-map proc . vecs)
(define (elt i)
(lambda (vec)
|
view (394 lines) |
; data encryption standard
(define (vector-map proc . vecs)
(define (elt i)
(lambda (vec)
|
view (394 lines) |
; data encryption standard
(define (vector-map proc . vecs)
(define (elt i)
(lambda (vec)
|
view (386 lines) |
; data encryption standard
(define (vector-map proc . vecs)
(define (elt i)
(lambda (vec)
|
view (246 lines, 2 lines of output) |
; data encryption standard
(define (vector-map proc . vecs)
(define (elt i)
(lambda (vec)
|
view (249 lines, 2 lines of output) |
; chinese remainder theorem
(define (euclid x y)
(let loop ((a 1) (b 0) (g x) (u 0) (v 1) (w y))
(if (zero? w) (values a b g)
|
view (23 lines, 1 line of output) |
; chinese remainder theorem
(define (euclid x y)
(let loop ((a 1) (b 0) (g x) (u 0) (v 1) (w y))
(if (zero? w) (values a b g)
|
view (33 lines, 7 lines of output) |
; shanks' square form factorization algorithm
(define (isqrt n)
(if (not (and (positive? n) (integer? n)))
(error 'isqrt "must be positive integer")
|
view (72 lines, 1 line of output) |
(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)))
|
view (70 lines, 1 line of output) |
; shanks's squfof
(define (isqrt n)
(if (not (and (positive? n) (integer? n)))
(error 'isqrt "must be positive integer")
|
view (153 lines, 1 line of output) |
/* from http://www.mindspring.com/~pate/course/chap08/squfof.c PLB 20AUG2010 */
/*
Author: Pate Williams (c) 1997
|
view (279 lines, 1 line of output) |
; marriage sort
(define (isqrt n)
(if (not (and (positive? n) (integer? n)))
(error 'isqrt "must be positive integer")
|
view (52 lines, 1 line of output) |
#! /usr/bin/scheme --script
(define (range . args)
(case (length args)
((1) (range 0 (car args) (if (negative? (car args)) -1 1)))
|
view (97 lines, 1 line of output) |
(define (getopt defn msg args) ; => (values (list opt/arg ...) (list file ...))
(define (parse-options defn)
(let loop ((options (string->list defn)) (lones '()) (args '()))
(cond ((null? options) (values lones args))
((null? (cdr options)) (values (cons (car options) lones) args))
|
view (28 lines) |
; two powering predicates
(define (isqrt n)
(if (not (and (positive? n) (integer? n)))
(error 'isqrt "must be positive integer")
|
view (138 lines, 9 lines of output) |
; e
(define rand #f)
(define randint #f)
(let ((two31 #x80000000) (a (make-vector 56 -1)) (fptr #f))
|
view (61 lines, 1 line of output) |
/^<<.+>>=$/ {
name = substr($0, 3, length($0) - 5)
while (getline > 0) {
if (length($0) == 0) next
chunk[name, ++count[name]] = $0 } }
|
view (18 lines) |
; two powering predicates
(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))
|
view (134 lines, 9 lines of output) |
; carl hewitt's same-fringe problem
(define-syntax define-record-type
(syntax-rules ()
((define-record-type type
|
view (248 lines, 1 line of output) |
; two powering predicates
(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))
|
view (130 lines, 7 lines of output) |
; hamurabi
(define rand #f)
(define randint #f)
(let ((two31 #x80000000) (a (make-vector 56 -1)) (fptr #f))
|
view (252 lines) |
; fibonacci numbers
(define (make-matrix rows columns . value)
(do ((m (make-vector rows)) (i 0 (+ i 1)))
((= i rows) m)
|
view (73 lines, 6 lines of output) |
; george marsaglia's random number generators
(define (ipow b e)
(cond ((zero? e) 1)
((even? e) (ipow (* b b) (/ e 2)))
|
view (113 lines, 1 line of output) |
; carl hewitt's same-fringe problem
(define-syntax define-record-type
(syntax-rules ()
((define-record-type type
|
view (248 lines, 1 line of output) |
; word cube
(define (read-line . port)
(define (eat p c)
(if (and (not (eof-object? (peek-char p)))
|
view (64 lines, 1 line of output) |
export PRAXIS=/home/phil/praxis
awk ' # permuted table of contents (page "permuted")
BEGIN { FS = "\n"; RS = ""
|
view (69 lines) |
; chaocipher
(define (take n xs)
(let loop ((n n) (xs xs) (ys '()))
(if (or (zero? n) (null? xs))
|
view (55 lines, 2 lines of output) |
; chaocipher
(define (take n xs)
(let loop ((n n) (xs xs) (ys '()))
(if (or (zero? n) (null? xs))
|
view (58 lines, 2 lines of output) |
; solving systems of linear equations
(define-syntax fold-of
(syntax-rules (range in is)
((_ "z" f b e) (set! b (f b e)))
|
view (168 lines, 7 lines of output) |
export PRAXIS=/home/phil/praxis
awk ' # exercises in chronological order (page "chron")
BEGIN { itemsperpage = 30; FS = "\n"; RS = ""
|
view (56 lines) |
; matrix operations
(define (make-matrix rows columns . value)
(do ((m (make-vector rows)) (i 0 (+ i 1)))
((= i rows) m)
|
view (102 lines, 5 lines of output) |
; parsing command-line arguments
(define (getopt defn msg args) ; => (values (list opt/arg ...) (list file ...))
(define (parse-options defn)
(let loop ((options (string->list defn)) (lones '()) (args '()))
|
view (30 lines) |
; natural join
(define (string-split sep str)
(define (f cs xs) (cons (list->string (reverse cs)) xs))
(let loop ((ss (string->list str)) (cs '()) (xs '()))
|
view (64 lines) |
; williams p+1 factorization algorithm
(define (ilog b n)
(if (zero? n) -1
(+ (ilog b (quotient n b)) 1)))
|
view (164 lines) |
; unwrapping a spiral
(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))
|
view (21 lines, 1 line of output) |
; pagination
(define (read-line . port)
(define (eat p c)
(if (and (not (eof-object? (peek-char p)))
|
view (52 lines) |
; integer logarithms
(define (ilog b n)
(if (zero? n) -1
(+ (ilog b (quotient n b)) 1)))
|
view (29 lines) |
; spectacular seven
(define rand
(let* ((a 3141592653) (c 2718281829)
(m (expt 2 35)) (x 5772156649)
|
view (65 lines, 1 line of output) |
; integer factorization
(define (expm b e m)
(define (m* x y) (modulo (* x y) m))
(cond ((zero? e) 1)
|
view (420 lines) |
; integer factorization
(define (expm b e m)
(define (m* x y) (modulo (* x y) m))
(cond ((zero? e) 1)
|
view (420 lines) |
; modern elliptic curve factorization, part 2
(define (ilog b n)
(if (zero? n) -1
(+ (ilog b (quotient n b)) 1)))
|
view (186 lines, 1 line of output) |
; modern elliptic curve factorization, part 1
(define (digits n . args)
(let ((b (if (null? args) 10 (car args))))
(let loop ((n n) (d '()))
|
view (82 lines, 10 lines of output) |
; proving primality
(define (expm b e m)
(define (m* x y) (modulo (* x y) m))
(cond ((zero? e) 1)
|
view (58 lines, 1 line of output) |
; 145-puzzle
(define (filter pred? xs)
(let loop ((xs xs) (ys '()))
(cond ((null? xs) (reverse ys))
|
view (114 lines, 2 lines of output) |
; expression evaluation
(define (numb xs)
(let loop ((n (- (char->integer (car xs)) 48)) (xs (cdr xs)))
(cond ((null? xs) (values n xs))
|
view (84 lines, 1 line of output) |
; traveling salesman: minimum spanning tree
(define rand
(let* ((a 3141592653) (c 2718281829)
(m (expt 2 35)) (x 5772156649)
|
view (226 lines, 2 lines of output) |
; minimum spanning tree: prim's algorithm
(define (remove x xs)
(let loop ((xs xs) (zs '()))
(cond ((null? xs) (reverse zs))
|
view (32 lines, 1 line of output) |
; minimum spanning tree: kruskal's algorithm
(define (make-hash hash eql? oops size)
(let ((table (make-vector size '())))
(lambda (message . args)
|
view (122 lines, 1 line of output) |
; minimum spanning tree: kruskal's algorithm
(define (make-hash hash eql? oops size)
(let ((table (make-vector size '())))
(lambda (message . args)
|
view (122 lines, 1 line of output) |
; disjoint sets
(define (make-hash hash eql? oops size)
(let ((table (make-vector size '())))
(lambda (message . args)
|
view (90 lines, 4 lines of output) |
; passover
(define (julian year month day)
(let* ((a (quotient (- 14 month) 12))
(y (+ year 4800 (- a)))
|
view (59 lines, 3 lines of output) |