[ create a new paste ] login | about

Project: programmingpraxis
Link: http://programmingpraxis.codepad.org/830f0msv    [ raw code | output | fork ]

programmingpraxis - Scheme, pasted on Apr 20:
; miscellanea

; fizzbuzz

(define (divides? d n) (zero? (modulo n d)))

(define (fizz-buzz n)
  (do ((i 1 (+ i 1))) ((< n i))
    (cond ((divides? 15 i) (display "FizzBuzz"))
          ((divides? 5 i) (display "Buzz"))
          ((divides? 3 i) (display "Fizz"))
          (else (display i)))
    (newline)))

(fizz-buzz 20)

(define (fb-sum n)
  (define (g n) (* 1/2 n (+ n 1)))
  (define (f k) (* k (g (quotient n k))))
  (+ (f 3) (f 5) (- (f 15))))

(do ((i 1 (+ i 1))) ((< 20 i))
  (display (fb-sum (- (expt 10 i) 1)))
  (newline))

; prime words

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

(define (strong-pseudo-prime? a n)
  (let loop ((r 0) (s (- n 1)))
    (if (even? s) (loop (+ r 1) (/ s 2))
      (if (= (expm a s n) 1) #t
        (let loop ((j 0) (s s))
          (cond ((= j r) #f)
                ((= (expm a s n) (- n 1)) #t)
                (else (loop (+ j 1) (* s 2)))))))))

; Zhenxiang Zhang and Min Tang, "Finding strong
; pseudoprimes to several bases. II," <em>Mathematics
; of Computation</em> 72 (2003), pp. 2085–2097,
; reported at http://math.crg4.com/primes.html.
(define (prime? n) ; n <= 318665857834031151167461
  (let loop ((as '(2 3 5 7 11 13 17 19 23 29 31 37)))
    (cond ((null? as) #t)
          ((strong-pseudo-prime? (car as) n)
            (loop (cdr as)))
          (else #f))))

(define (prime36? str)
  (prime? (string->number str 36)))

; (display (prime36? "PRAXIS")) (newline)
; (display (prime36? "LISP")) (newline)

(define (undigits ds . args)
  (let ((b (if (null? args) 10 (car args))))
    (let loop ((ds ds) (n 0))
      (if (null? ds) n
          (loop (cdr ds) (+ (* n b) (car ds)))))))

(define (digit c)
  (cond ((char<=? #\0 c #\9) (- (char->integer c) 48))
        ((char<=? #\A c #\Z) (- (char->integer c) 55))
        ((char<=? #\a c #\z) (- (char->integer c) 87))
        (else (error 'digit "invalid character"))))

(define (radix36 s)
  (undigits (map digit (string->list s)) 36))

(define (prime36? str)
  (prime? (radix36 str)))

(display (prime36? "PRAXIS")) (newline)
(display (prime36? "LISP")) (newline)

; split a list

(define (split! xs)
  (let loop ((t xs) (h (cdr xs)))
  (if (or (null? h) (null? (cdr h)))
      (let ((h (cdr t)))
        (set-cdr! t '())
        (values xs h))
      (loop (cdr t) (cddr h)))))

(call-with-values
  (lambda ()
    (split! '(1 2 3 4)))
  (lambda (f b)
    (display f) (newline)
    (display b) (newline)))

(call-with-values
  (lambda ()
    (split! '(1 2 3 4 5)))
  (lambda (f b)
    (display f) (newline)
    (display b) (newline)))

(define (split xs)
  (let loop ((xs xs) (ts '()) (hs xs))
    (cond ((null? hs) (values (reverse ts) xs))
          ((null? (cdr hs)) (values (reverse ts) xs))
          (else (loop (cdr xs) (cons (car xs) ts) (cddr hs))))))

(call-with-values
  (lambda ()
    (split '(1 2 3 4)))
  (lambda (f b)
    (display f) (newline)
    (display b) (newline)))

(call-with-values
  (lambda ()
    (split '(1 2 3 4 5)))
  (lambda (f b)
    (display f) (newline)
    (display b) (newline)))


Output:
1
2
Fizz
4
Buzz
Fizz
7
8
Fizz
Buzz
11
Fizz
13
14
FizzBuzz
16
17
Fizz
19
Buzz
23
2318
233168
23331668
2333316668
233333166668
23333331666668
2333333316666668
233333333166666668
23333333331666666668
2333333333316666666668
233333333333166666666668
23333333333331666666666668
2333333333333316666666666668
233333333333333166666666666668
23333333333333331666666666666668
2333333333333333316666666666666668
233333333333333333166666666666666668
23333333333333333331666666666666666668
2333333333333333333316666666666666666668
#f
#t
(1 2)
(3 4)
(1 2 3)
(4 5)
(1 2)
(3 4)
(1 2)
(3 4 5)


Create a new paste based on this one


Comments: