; coin change, part 1

(define (count xs n)
  (let ((cs (make-vector (+ n 1) 0)))
    (vector-set! cs 0 1)

; mindcipher

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

; three list exercises

(define (remove-nth n xs)
  (let loop ((i 1) (xs xs) (zs (list)))
    (cond ((null? xs) (reverse zs))

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

; pairing students

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

; correct horse battery staple

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

; correct horse battery staple

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

; integer roots

(define (iroot k n)
  (let loop ((hi 1))
    (if (< (expt hi k) n)

; date formatting

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

; date formatting

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

; booth's algorithm

(define-syntax while
  (syntax-rules ()
    ((while pred? body ...)

; cyclic equality

(define (cycle . xs) (set-cdr! (last-pair xs) xs) xs)

(define (last-pair xs)

# 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"

; baillie-wagstaff pseudoprimality test

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

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

; quadratic sieve

(define verbose? #t)

(define sort #f)

; one million hits

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

; google code jam qualification round africa 2010, revisited

(define (make-dict lt?)

  (define-syntax define-generator

; jumping jack

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

; quadratic sieve

(define verbose? #t)

(define (primes n)

; an array of two symbols

(define (make-list n x)
  (let loop ((n n) (xs '()))
    (if (zero? n) xs

; quadratic sieve

(define verbose? #t)

(define (primes n)

; buffon's needle

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

; an array of two symbols

(define (make-list n x)
  (let loop ((n n) (xs '()))
    (if (zero? n) xs

; 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

-- knight moves

type KnightPos = (Int,Int)
 
moveKnight :: KnightPos -> [KnightPos]

; dutch national flag

(define examine vector-ref)

(define (swap! xs p1 p2)

# 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"

; baillie-wagstaff pseudoprimality test

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

; an odd way to square

(define (square n)
  (let loop ((x n) (s 0))
    (if (zero? x) (+ s s (- n))

; lucas pseudoprimality tester

; based on trn.c from http://www.trnicely.net/misc/bpsw.html

; jacobi a m -- jacobi symbol

# lucas pseudoprimality tester

# based on trn.c from http://www.trnicely.net/misc/bpsw.html

def gcd(a, b):

# lucas pseudoprimality tester

# based on trn.c from http://www.trnicely.net/misc/bpsw.html

def gcd(a, b):

; lucas pseudoprimality tester

; based on trn.c from http://www.trnicely.net/misc/bpsw.html

; jacobi a m -- jacobi symbol

; floupia

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

; floupia

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

; npr sunday puzzle

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

; 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

; binary search tree: in-order predecessor and successor

(define (tree key lkid rkid) (vector key lkid rkid))

(define (key tree) (vector-ref tree 0))

/* bigprime.c -- save the digits of 2^57885161-1 to a file */

#include <stdio.h>
#include "gmp.h"

; the 147 puzzle

(define (f k)
  (let ((fss (list)))
    (let loop1 ((k k) (n 1) (d 1) (fs (list)))

-- hofstadter's sequence

import Data.List

hofstadter = 1 : figure 1 [2..] where

-- hofstadter's sequence

import Data.List

hofstadter = 1 : figure 1 [2..] where

; 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

; hofstadter's sequence

(define (hofstadter n)
  (let ((k 5))
    (let loop ((n (- n 2)) (rs (list 3 1)) (ss (list 4 2)))

# imperative heaps

function swap(i, j,    t) {
    t = x[i]
    x[i] = x[j]

; splay heaps

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

; triangle trilemma

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

(define (string-join sep ss)
  (define (f s ss)
    (string-append s (string sep) ss))
  (define (join ss)
    (if (null? (cdr ss)) (car ss)

; floating point rounding

(define (round f n)
  (/ (truncate (+ (* f (expt 10 n)) 0.5)) (expt 10 n)))

; four points determine a square

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

; happy new year

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

(define (catenate ss) (apply string (mappend string->list ss)))

; three wise men

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

; building primes

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

; the seven immortals

(define (immortals n)
  (define (binom n k)
    (let loop ((n n) (k k) (b 1))

; 115132219018763992565095597973971522401

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

; stepwise program development: a heuristic algorithm

(define-syntax while
  (syntax-rules ()
    ((while pred? body ...)

; wirth problem 15.12

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

; median of five

(define (permutations xs)
  (define (rev xs n ys)
    (if (zero? n) ys

; selection, revisited

(define (split n xs)
  (let loop ((n n) (xs xs) (zs '()))
    (if (or (zero? n) (null? xs))

; amazon interview question

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

(define rand #f)

; tonelli-shanks algorithm

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

; list difference

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

; list intersection and union

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

; list intersection and union

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

; taxicab numbers

(define (root3 n)
  (let loop ((u n))
    (let* ((s u)

; fix something annoying

(define old-round round)

(define (round x . args)

; gasoline mileage log

(define (display1 x)
  (let ((x (inexact->exact (floor (* 10 x)))))
    (display (quotient x 10))

; pandigital numbers

(define (pandigital? . xs)
  (let ((ds (make-vector 10 #f)))
    (let x-loop ((xs xs))

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

; pythagorean triples

(define (euclid limit)
  (define (trip m n)
    (let ((m2 (* m m)) (n2 (* n n)))

; universal hash function

(define (hash x)
  (define (mod n) (modulo n 4294967296))
  (cond ((boolean? x) (if x 1 0))

; prime partitions

(define (prime-parts n)
  (let ((sopf (make-vector (+ n 1) 0))
        (kappa (make-vector (+ n 1) 0)))

#! /usr/bin/scheme --script

; put, get, dir -- version control system

(define (read-line . port)

; two word games

(define (sorted? lt? xs)
  (if (null? xs) #t
    (if (null? (cdr xs)) #t

; petals around the rose

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

; aks primality prover

(define (split n xs)
  (let loop ((n n) (xs xs) (zs '()))
    (if (or (zero? n) (null? xs))

; aks primality prover, part 1

(define (split n xs)
  (let loop ((n n) (xs xs) (zs '()))
    (if (or (zero? n) (null? xs))

; aks primality prover

(define (split n xs)
  (let loop ((n n) (xs xs) (zs '()))
    (if (or (zero? n) (null? xs))

(define (split n xs)
  (let loop ((n n) (xs xs) (zs '()))
    (if (or (zero? n) (null? xs))
        (values (reverse zs) xs)
        (loop (- n 1) (cdr xs) (cons (car xs) zs)))))

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

; birthday paradox

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

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

; abc conjecture

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

; tribonacci numbers

(define (iterate n f . bs)
  (let loop ((n n) (b (car bs)) (bs (cdr bs)) (xs '()))
    (if (zero? n) (reverse xs)

; the sum of the first billion primes

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

; the first two programs

(define (hello)
  (display "Hello, world!")
  (newline))

; fountain codes

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

; hash tables with open addressing
; knuth aocp3 sec 6.4 algo L and R

(define (filter pred? xs)
  (let loop ((xs xs) (ys '()))

; 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

; hash tables with open addressing

(define (string-hash str)
  (let loop ((cs (string->list str)) (s 0))
    (if (null? cs) s

; hash tables with open addressing

(define (string-hash str)
  (let loop ((cs (string->list str)) (s 0))
    (if (null? cs) s

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

; two random exercises

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

; 4sum

(define (cons* first . rest)
  (let loop ((curr first) (rest rest))
    (if (null? rest) curr

; minimum sum product

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

(define sort #f)

; make

(define (string-split sep str)
  (define (f cs xs) (cons (list->string (reverse cs)) xs))
  (let loop ((ss (string->list str)) (cs '()) (xs '()))

; once in a blue moon

(define (julian year month day)
  (let* ((a (quotient (- 14 month) 12))
         (y (+ year 4800 (- a)))

; send + more = money

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

(define (make-list n x)

; send + more = money

(define (fail)
  (error 'amb "tree exhausted"))

; send + more = money

(define (fail)
  (error 'amb "tree exhausted"))

; min stack

(define empty (list (list)))

(define (empty? x) (equal? empty x))

; infix expression evaluation

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

; breshenham's line-drawing algorithm

(define esc (integer->char 27))
(define (cls)
  (display esc) (display #\[)

; zeckendorf representation
; reddit.com/r/dailyprogrammer challenge #74 easy

(define (fibs n)
  (let loop ((f2 1) (f1 1) (f 2) (fs (list 1 1)))

; sieving for totients

(define (totients n)
  (let ((tots (make-vector (+ n 1))))
    (do ((i 0 (+ i 1))) ((< n i))

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

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

; chopping words

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

; sliding median

(define (make-dict lt?)

  (define-syntax define-generator

; billboard challenge, part 2

(define (prime? n)
  (if (even? n) #f
    (let loop ((f 3))

; billboard challenge, part 1

(define (prime? n)
  (if (even? n) #f
    (let loop ((f 3))

; digits of e

(define (make-list n x)
  (let loop ((n n) (xs '()))
    (if (zero? n) xs

; unbounded spigots

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

; counting ones

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

; billboard challenge, part 1

(define (make-list n x)
  (let loop ((n n) (xs '()))
    (if (zero? n) xs

(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

#! /usr/bin/scheme --script

(define (do-file file-name)
  (let ((p (if (string=? file-name "-")
               (current-input-port)

; binomial heaps

(define node vector) ; rank item kids
(define (rank n) (vector-ref n 0))
(define (item n) (vector-ref n 1))

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

; streaming median

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

; ackermann's function

(define (a m n)
  (cond ((zero? m) (+ n 1))
        ((zero? n) (a (- m 1) 1))

; hamming codes

; http://www2.rad.com/networks/1994/err_con/hamming.htm

(define (make-matrix rows columns . value)

; formatted numeric output

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

; formatted numeric output

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

; streaming knapsack

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

; partitions

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

; factor tables

(define (lpf-sieve n)
  (let* ((len (quotient (- n 1) 2))
         (lpf (make-vector len 1)))

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

; trabb pardo-knuth algorithm
 
(define (tpk len)
  (define (f x) (+ (sqrt (abs x)) (* 5 x x x)))
  (let loop ((len len) (nums '()))

; even-odd partition

(define (even-odd vec)
  (define (swap! a b)
    (let ((t (vector-ref vec a)))

; rhyming dictionary

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

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

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

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

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

# programming with prime numbers

def primes(n):
    if type(n) != int and type(n) != long:
        raise TypeError('must be integer')

# programming with prime numbers

def primes(n):
    if type(n) != int and type(n) != long:
        raise TypeError('must be integer')

; galton

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

; voters

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

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

; programming with prime numbers

(define (primes n)
  (if (or (not (integer? n)) (< n 2))
      (error 'primes "must be integer greater than one")

/* prime.c -- programming with prime numbers
 * compile as: gcc -O3 prime.c -o prime
 * run as: ./prime */
 
#include <stdio.h>

/* prime.c -- programming with prime numbers
 * compile as: gcc -O3 prime.c -lgmp -o prime
 * run as: ./prime */

#include <stdio.h>

; subset sum, meet in the middle

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

; subset sum
(define (make-hash hash eql? oops size)
  (let ((table (make-vector size '())))
    (lambda (message . args)
      (if (eq? message 'enlist)

; base-26 arithmetic

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

-- programming with prime numbers
 
import Control.Monad (forM_, when)
import Control.Monad.ST
import Data.Array.ST

-- programming with prime numbers
 
import Control.Monad (forM_, when)
import Control.Monad.ST
import Data.Array.ST

-- programming with prime numbers
 
import Control.Monad (forM_, when)
import Control.Monad.ST
import Data.Array.ST

; factoring multiple rsa keys

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

; sum of squares of two largest of three values

(define-syntax assert
  (syntax-rules ()
    ((assert expr result)

; perfect power predicate

(define (iroot k n)
  (let loop ((u n))
    (let* ((s u)

-- programming with prime numbers
 
import Control.Monad (forM_, when)
import Control.Monad.ST
import Data.Array.ST

-- programming with prime numbers
 
import Control.Monad (forM_, when)
import Control.Monad.ST
import Data.Array.ST

/* prime.c -- programming with prime numbers
 * compile as: gcc -O3 prime.c -lgmp -o prime
 * run as: ./prime */

#include <stdio.h>