; ten-digit pandigital numbers divisible by 1 through 9

(define sort #f)
(define merge #f)
(let ()

(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)))

; project euler problem 1

(define (one n)
  (let ((sieve (make-vector n 0)))
    (do ((i 3 (+ i 3))) ((<= n i))

; two stream selection questions

(define (range . args)
  (case (length args)
    ((1) (range 0 (car args) (if (negative? (car args)) -1 1)))

; closest pair, part 1

(define rand #f)
(define randint #f)
(let ((two31 #x80000000) (a (make-vector 56 -1)) (fptr #f))

; m4 macros

(define (fact n d)
  (if (< n (* d d))
      (list n)

; sum of four primes

(define (prime? n)
  (if (even? n) (= n 2)
    (let loop ((d 3))

# 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

# sum of primes less than n
# sieve of eratosthenes

from time import time

# fibonacci conjecture

from random import randint

def isPrime(n, k=5): # miller-rabin

; largest forward difference

(define (largest-forward-difference xs)
  (let ((lfd 0))
    (do ((xs xs (cdr xs))) ((null? xs) lfd)

; 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)))

; 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))

; lucas-carmichael number

(define-syntax fold-of
  (syntax-rules (range in is)
    ((_ "z" f b e) (set! b (f b e)))

; one-time pad

(define-syntax for
  (syntax-rules ()
    ((for (var first past step) body ...)

; diana cryptosystem

(define rand #f)
(define randint #f)
(let ((two31 #x80000000) (a (make-vector 56 -1)) (fptr #f))

; find two added integers

(define sort #f)
(define merge #f)
(let ()

; magic squares

(define (make-matrix rows columns . value)
  (do ((m (make-vector rows)) (i 0 (+ i 1)))
      ((= i rows) m)

; every possible fraction

(define-syntax define-generator
  (lambda (x)
    (syntax-case x (lambda)

; free time

(define (flatten xs)
  (cond ((null? xs) xs)
        ((pair? xs)

; gray code neighbors

(define (logand a b)
  (if (or (zero? a) (zero? b)) 0
    (+ (* (logand (floor (/ a 2)) (floor (/ b 2))) 2)

; ancient algorithms

(define (product left right)
  (let loop ((left left) (right right) (prod 0))
    (if (zero? left) prod

; a prime number puzzle

(define (two-digit-primes)
  (let ((sieve (make-vector 100 #t)))
    (do ((p 2 (+ p 1))) ((<= 100 p) (newline))

; thou impertinent urchin-faced miscreant

(define (string-join sep ss)
  (define (f s ss)
    (string-append s (string sep) ss))

; an array of zeroes

(define (zeroes vec)
  (let loop ((lo 0) (hi (- (vector-length vec) 1)) (counter 0))
    (cond ((< hi lo) (values counter vec))

; damm algorithm
; http://en.wikipedia.org/wiki/Damm_algorithm

(define (digits n . args)
  (let ((b (if (null? args) 10 (car args))))

; dawkins weasel

(define (range . args)
  (case (length args)
    ((1) (range 0 (car args) (if (negative? (car args)) -1 1)))

; dawkins weasel
; http://en.wikipedia.org/wiki/Weasel_program

(define (range . args)
  (case (length args)

# favorite color

awk ' /^favoritecolor: / { color[$2]++ }
      END { for (c in color) print color[c], c } ' database |
sort -rn |

; gaussian integers, part 1

(define (gs a b) (cons a b))
(define (re x) (car x))
(define (im x) (cdr x))

; gaussian integers, part 1

(define (gs a b) (cons a b))
(define (re x) (car x))
(define (im x) (cdr x))

; gaussian integers, part 1

(define (gs a b) (cons a b))
(define (re x) (car x))
(define (im x) (cdr x))

; number of divisors in a range

(define (f x y n)
  (- (quotient (- y 1) n)
    (quotient x n)))

; three farmers

(define-syntax fold-of
  (syntax-rules (range in is)
    ((_ "z" f b e) (set! b (f b e)))

; two-base palindromes

(define (digits n . args)
  (let ((b (if (null? args) 10 (car args))))
    (let loop ((n n) (d '()))

; two-base palindromes

(define (digits n . args)
  (let ((b (if (null? args) 10 (car args))))
    (let loop ((n n) (d '()))

; blackjack

(define (take n xs)
  (let loop ((n n) (xs xs) (ys '()))
    (if (or (zero? n) (null? xs))

; 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))

; belphegor primes

(define (isqrt n)
  (if (not (and (positive? n) (integer? n)))
      (error 'isqrt "must be positive integer")

import sys

def justify(filename, width = 60):
    with open(filename, 'r') as file:
        words, cnt, size, dir = [], 0, 0, 0

; text formatting

(define (read-line . port)
  (define (eat p c)
    (if (and (not (eof-object? (peek-char p)))

; magic 1089

(define (rev n)
  (let loop ((n n) (x 0))
    (if (zero? n) x

; wheel factorization

(define (last-pair xs)
  (if (null? (cdr xs)) xs
    (last-pair (cdr xs))))

; thue-morse sequence

(define (complement digits)
  (map (lambda (d) (if (zero? d) 1 0)) digits))

; 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))

; triangle roll-up

(define (but-last xs) (reverse (cdr (reverse xs))))

(define (pair-wise f xs) (map f (but-last xs) (cdr xs)))

; diophantine reciprocals

(define (xy-pairs n)
  (let loop ((x (+ n 1)) (xys (list)))
    (if (< (+ n n) x)

; diophantine reciprocals

(define (last-pair xs)
  (let ((tail (cdr xs)))
    (if (pair? tail) (last-pair tail) xs)))

; torn numbers

(define (torn? n)
  (define (square x) (* x x))
  (let loop ((ten-power 10))

; levenshtein distance

(define (make-matrix rows columns . value)
  (do ((m (make-vector rows)) (i 0 (+ i 1)))
      ((= i rows) m)

; skyline puzzle

(define (heights buildings)
  (let* ((len (apply max (map caddr buildings)))
         (hites (make-vector (+ len 1) 0)))

; longest increasing subsequence

(define (deal deck)
  (let loop ((deck deck) (selip (list)) (piles (list)))
    (cond ((null? deck) piles) ; no more cards in deck

; generating palindromes

(define (digits n . args)
  (let ((b (if (null? args) 10 (car args))))
    (let loop ((n n) (d '()))

; integer logarithm

(define (leftmost-digit base n)
  (if (< n base)
      n

; drawing diamonds

(define (star) (display #\*))

(define (blanks n)

; patience sorting

(define (deal deck)
  (let loop ((deck deck) (selip (list)) (piles (list)))
    (cond ((null? deck) piles) ; no more cards in deck

; big modular exponentiation

(define p 34534985349875439875439875349875)
(define q 93475349759384754395743975349573495)
(define m (+ (expt 10 9) 7))

; minimal palindromic base

(define (range . args)
  (case (length args)
    ((1) (range 0 (car args) (if (negative? (car args)) -1 1)))

; minimal palindromic base

(define (range . args)
  (case (length args)
    ((1) (range 0 (car args) (if (negative? (car args)) -1 1)))

; minimal palindromic base

(define (range . args)
  (case (length args)
    ((1) (range 0 (car args) (if (negative? (car args)) -1 1)))

; minimal palindromic base

(define (range . args)
  (case (length args)
    ((1) (range 0 (car args) (if (negative? (car args)) -1 1)))

; k'th largest item

(define pq-empty '())
(define pq-empty? null?)

/* montgomery multiplication */

typedef unsigned long long ull;
typedef signed long long sll;

; number words

(define (digits n . args)
  (let ((b (if (null? args) 10 (car args))))
    (let loop ((n n) (d '()))

; maximum sum path

(define sample
  '((3)
    (7 4)

; how fermat factored integers

(define (sprintf fmt . args)
  (define (escape cs)
    (define (octal? c) (char<=? #\0 c #\7))

; 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))

# 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

# 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

# moonrise / moonset

from __future__ import division
from math import sqrt, pi, sin, cos, atan

; minimum and maximum

(define (first-min-max xs)
  (if (null? xs) (error 'first-min-max "empty input")
    (list (apply min xs) (apply max xs))))

# prime numbers

def primes(n): # sieve of eratosthenes
    i, p, ps, m = 0, 3, [2], n // 2
    sieve = [True] * m

# moonrise / moonset

from math import sqrt, pi, sin, cos, atan

def signum(x):

; busy beaver

(define (make-hash hash eql? oops size)
  (let ((table (make-vector size '())))
    (lambda (message . args)

# rosters.awk

BEGIN { OFS = "|" }

/Captain/ { next }

; collinearity

(define sort #f)
(define merge #f)
(let ()

; minimax pandigital factor

(define (range . args)
  (case (length args)
    ((1) (range 0 (car args) (if (negative? (car args)) -1 1)))

; balanced delimiters

(define (balanced? str)
  (let ((starters '(#\( #\[ #\{)) (enders '(#\) #\] #\})))
    (let loop ((cs (string->list str)) (xs (list)))

; minimax pandigital factor

; http://www.reddit.com/r/math/comments/2749y4/
; a_problem_i_came_up_with_and_havent_been_able_to/

; remove singleton

(define (remove-singleton c str)
  (define (none ins outs)
    (cond ((null? ins) outs)

; roman numerals

(define-syntax list-match
  (syntax-rules ()
    ((_ expr (pattern fender ... template) ...)

; subset sum clrs 35.5, part 2

(define (filter pred? xs)
  (let loop ((xs xs) (ys '()))
    (cond ((null? xs) (reverse ys))

; subset sums clrs 35.5

(define (filter pred? xs)
  (let loop ((xs xs) (ys '()))
    (cond ((null? xs) (reverse ys))

; 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)

; amicable chains

(define sort #f)
(define merge #f)
(let ()

; rolling code

(define fob1
  (let ( ; permanent read-only memory
         (id 111) (k 948579992)

; 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)))

; cluster

(define sort #f)
(define merge #f)
(let ()

; packed ascii

(define (drop n xs)
  (let loop ((n n) (xs xs))
    (if (or (zero? n) (null? xs)) xs

; binary reflected gray code

(define (ash int cnt)
  (if (negative? cnt)
      (let ((n (expt 2 (- cnt))))

; solovay-strassen primality test

(define (square x) (* x x))

(define (expm b e m)

; assembler, part 3

(define (sprintf fmt . args)
  (define (escape cs)
    (define (octal? c) (char<=? #\0 c #\7))

; assembler, part 2

(define labels (list))

(define opcodes '(("const" . 0) ("get" . 1) ("put" . 2)

; assembler, part 1

(define labels (list))

(define opcodes '(("const" . 0) ("get" . 1) ("put" . 2)

; 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)

; factoring with bicycle chains

(define (isqrt n)
  (if (not (and (positive? n) (integer? n)))
      (error 'isqrt "must be positive integer")

; formatted output

(define (sprintf fmt . args)
  (define (escape cs)
    (define (octal? c) (char<=? #\0 c #\7))

; factoring rsa moduli

(define (expm b e m)
  (define (m* x y) (modulo (* x y) m))
  (cond ((zero? e) 1)

; lucky numbers

(define (range . args)
  (case (length args)
    ((1) (range 0 (car args) (if (negative? (car args)) -1 1)))

; root finding

(define (signum x)
  (if (negative? x) -1 (if (positive? x) 1 0)))

; caesar cipher

(define (caesar n str)
  (define (char-plus c)
    (let ((alpha "ABCDEFGHIJKLMNOPQRSTUVWXYZ"))

; factoring by digital coding

(define (mappend f . xss)
  (apply append (apply map f xss)))

; 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)))

; 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)))

; modest prime-number library

(defn gcd "greatest common divisor" [a b]
  (if (zero? b) a (gcd b (mod a b))))

; profiling

(define sort #f)
(define merge #f)
(let ()

; crossing hands

(define (range . args)
  (case (length args)
    ((1) (range 0 (car args) (if (negative? (car args)) -1 1)))

; anagrams within words

(define (take n xs)
  (let loop ((n n) (xs xs) (ys '()))
    (if (or (zero? n) (null? xs))

; two interview questions

(define sort #f)
(define merge #f)
(let ()

# -*- coding: utf-8 -*-
"""
Created on Fri Jan 31 13:34:25 2014

@author:Paul Hofstra

;  years, months, days

(define-syntax (define-structure x)
  (define (gen-id template-id . args)
    (datum->syntax-object template-id

; 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)))

; lucas pseudoprimes

(define-syntax fold-of
  (syntax-rules (range in is)
    ((_ "z" f b e) (set! b (f b e)))

; hart's one-line factoring algorithm

(define sort #f)
(define merge #f)
(let ()

; reservoir sampling

(define (take n xs)
  (let loop ((n n) (xs xs) (ys '()))
    (if (or (zero? n) (null? xs))

; factoring factorials

(define (primes n)
  (let ((sieve (make-vector (+ n 1) #t)))
    (let loop ((p 2) (ps (list)))

; shuffle box

(define knuth
  (let* ((a 69069) (c 1234567) (m 4294967296)
         (seed (current-seconds)))

; minimum standard random number generator

(define (logand a b)
  (if (or (zero? a) (zero? b)) 0
    (+ (* (logand (floor (/ a 2)) (floor (/ b 2))) 2)

; baillie-wagstaff pseudoprimality test

(define (isqrt n)
  (if (not (and (positive? n) (integer? n)))
      (error 'isqrt "must be positive integer")

; lucas sequences

(define (range . args)
  (case (length args)
    ((1) (range 0 (car args) (if (negative? (car args)) -1 1)))

; the divisor function sigma

(define sort #f)
(define merge #f)
(let ()

; counting zeros

(define (filter pred? xs)
  (let loop ((xs xs) (ys '()))
    (cond ((null? xs) (reverse ys))

; 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

; remove duplicates from a list

(define (range . args)
  (case (length args)
    ((1) (range 0 (car args) (if (negative? (car args)) -1 1)))

; modular factorial

(define (mod-fact n m)
  (let loop ((k 2) (p 1))
    (if (< n k) p

; 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)))

; 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)))

; rock paper scissors

(define rand #f)
(define randint #f)
(let ((two31 #x80000000) (a (make-vector 56 -1)) (fptr #f))

; left-handed words

(define (all? pred? xs)
  (cond ((null? xs) #t)
        ((pred? (car xs))

; reversing parts of a list

(define (take n xs)
  (let loop ((n n) (xs xs) (ys '()))
    (if (or (zero? n) (null? xs))

# i before e

awk '

    /^#/ { next }

; and the winner is

(define (sum xs) (apply + xs))

(define sort #f)

; and the winner is

(define (sum xs) (apply + xs))

(define sort #f)

; fletcher's checksum

(define (readc n)
  (if (eof-object? (peek-char)) -1
    (let loop ((k n) (v 0))

# modular testing

def gcd(m,n):
    while n <> 0:
        m, n = n, m % n

/* sum of primes less than two million */

#include <stdlib.h>
#include <stdio.h>
#include <string.h>

(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))

; minimum hamming distance

(define (logand a b)
  (if (or (zero? a) (zero? b)) 0
    (+ (* (logand (floor (/ a 2)) (floor (/ b 2))) 2)

; 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)))

; queues

(define (make-queue) (list (list)))

(define (enqueue q x) (cons (car q) (cons x (cdr q))))

; the 16 game

(define (range . args)
  (case (length args)
    ((1) (range 0 (car args) (if (negative? (car args)) -1 1)))

; pessimal algorithms and simplexity analysis

(define (slowsort a i j)
  (when (< i j)
    (let ((m (quotient (+ i j) 2)))

; david gries' coffee can problem

(define rand #f)
(define randint #f)
(let ((two31 #x80000000) (a (make-vector 56 -1)) (fptr #f))

; binary tree traversal

(define (split-while pred? xs)
  (let loop ((xs xs) (ys '()))
    (if (or (null? xs) (not (pred? (car xs))))

; find the minimum difference

(define (f xs ys)
  (let ((d (- (car xs) (car ys))))
    (let loop ((xs xs) (ys ys) (diff (abs d)))

/* imperative-style linked lists */

#include <stdio.h>
#include <stdlib.h>

/* imperative-style linked lists */

#include <stdio.h>
#include <stdlib.h>

; functional-style linked lists

(define (error symb str)
  (display "error: ")
  (display (symbol->string symb))

; calculating statistics

(define (make-dict lt?)

  (define-syntax define-generator

; lucas sequences

(define (lucas l2 l1 n)
  (let loop ((n n) (l2 l2) (l1 l1) (ls (list l1 l2)))
    (if (zero? n) (reverse ls)

# 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

; finding digit strings in powers of two

(define (string-find pat str . s)
  (let* ((plen (string-length pat))
         (slen (string-length str))

; mccarthy's 91 function

(define (m n)
  (if (< 100 n) (- n 10)
    (m (m (+ n 11)))))

; smallest consecutive four-factor composites

(define (unique eql? xs)
  (cond ((null? xs) '())
        ((null? (cdr xs)) xs)