2. Numbers

;; Strings and numbers are separate data types in Scheme, so this
;; isn't as important as it is in Perl.  More often you would use the
;; type predicates, string? and number?.

(if (string-match "[^\\d]" str) (display "has nondigits"))
(or (string-match "^\\d+$" str) (display "not a natural number"))
(or (string-match "^-?\\d+$" str) (display "not an integer"))
(or (string-match "^[\\-+]?\\d+$" str) (display "not an integer"))
(or (string-match "^-?\\d+\.?\d*$" str) (display "not a decimal number"))
(or (string-match "^-?(\d+(\.\d*)?|\.\d+)$" str)
    (display "not a decimal number"))
(or (string-match "^([+-]?)(\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?$" str)
    (display "not a C float"))

(define num1 (string->number str))

(define num2 (read))

;; (approx-equal? num1 num2 accuracy) : returns #t if num1 and num2 are
;;   equal to accuracy number of decimal places
(define (approx-equal? num1 num2 accuracy)
  (< (abs (- num1 num2)) (expt 10.0 (- accuracy))))

(define wage 536)                     ;; $5.36/hour
(define week (* 40 wage))             ;; $214.40
(format #t "One week's wage is: $~$\n" (/ week 100.0))

(round num)                           ;; rounds to inexact whole number
(inexact->exact num)                  ;; rounds to exact integer

;; You can also use format to convert numbers to more precisely
;; formatted strings.  Note Guile has a builtin format which is a more
;; limited version of that found in the (ice-9 format) module, to save
;; load time.  Basically, if you are doing anything you couldn't do
;; with a series of (display), (write) and (newline), then you'll need
;; to use the module.
(use-modules (ice-9 format))

(define a 0.255)
(define b (/ (round (* 100.0 a)) 100.0))
(format #t "Unrounded: ~F\nRounded: ~F\n" a b)
(format #t "Unrounded: ~F\nRounded: ~,2F\n" a a)

(define a '(3.3 3.5 3.7 -3.3))
(display "number\tint\tfloor\tceil\n")
(for-each
 (lambda (n)
   (format #t "~,1F\t~,1F\t~,1F\t~,1F\n"
           n (round n) (floor n) (ceiling n)))
 a)

;; numbers are radix independent internally, so you usually only
;; convert on output, however to convert strings:
(define (dec->bin num)
  (number->string (string->number num 10) 2))

(define (bin->dec num)
  (number->string (string->number num 2) 10))

(define num (bin->dec "0110110"))  ; 54
(define binstr (dec->bin "54"))    ; 110110

;; do is the most general loop iterator
(do ((i x (1+ i)))   ; var  init-value  step-value
    ((> i y))        ; end when true
  ;; i is set to every integer from x to y, inclusive
  ;; ...
  )

;; Guile also offers a while loop
(let ((i x))
  (while (<= i y)
         ;; i is set to every integer from x to y, inclusive
         ; ...
         (set! i (1+ i))))

;; named let is another common loop
(let loop ((i x))
  (cond ((<= i y)
         ;; i is set to every integer from x to y, step-size 7
         ;; ...
         (loop (+ i 7)))))  ; tail-recursive call

(display "Infancy is: ")
(do ((i 0 (1+ i)))
    ((> i 2))
  (format #t "~A " i))
(newline)

(display "Toddling is: ")
(let ((i 3))
  (while (<= i 4)
         (format #t "~A " i)
         (set! i (1+ i))))
(newline)

(display "Childhood is: ")
(let loop ((i 5))
  (cond ((<= i 12)
         (format #t "~A " i)
         (loop (1+ i)))))
(newline)

;; format can output roman numerals - use ~:@R

(use-modules (ice-9 format))

(format #t "Roman for ~R is ~:@R\n" 15 15)

(random 5)        ; an integer from 0 to 4
(random 5.0)      ; an inexact real in the range [0,5)

;; char sets from SRFI-14 and string-unfold from SRFI-13 make a quick
;; way to generate passwords

(use-modules (srfi srfi-13) (srfi srfi-14))

(define chars (char-set->string char-set:graphic))
(define size (char-set-size char-set:graphic))
(define password
  (string-unfold (lambda (x) (= x 8))
                 (lambda (x) (string-ref chars (random size)))
                 1+ 0))

;; if you're working with random numbers you'll probably want to set
;; the random seed

(seed->random-state (current-time))

;; you can also save random states and pass them to any of the above
;; random functions

(define state (copy-random-state))
(random:uniform)
;; 0.939377327721761
(random:uniform state)
;; 0.939377327721761

;; @@INCOMPLETE@@
;; very inefficient
(use-modules (ice-9 rw))
(define make-true-random
  (letrec ((bufsize 8)
           (accum (lambda (c acc) (+ (* 256 acc)
                                     (char->integer c))))
           (getbuf (lambda ()
                     (call-with-input-file "/dev/urandom"
                       (lambda (p)
                         (let ((buf (make-string bufsize)))
                           (read-string!/partial buf p)
                           buf))))))
    (lambda (rand-proc)
      (lambda args
        (let ((state (seed->random-state (string-fold accum 0 (getbuf)))))
          (apply rand-proc (append args (list state))))))))

(define urandom (make-true-random random))
(define urandom:exp (make-true-random random:exp))
(define urandom:normal (make-true-random random:normal))
(define urandom:uniform (make-true-random random:uniform))

;; Guile offers a number of random distributions

(random:exp)      ; an inexact real in an exponential dist with mean 1
(random:normal)   ; an inexact real in a standard normal distribution
(random:uniform)  ; a uniformly distributed inexact real in [0,1)

;; There are also functions to fill vectors with random distributions

;; Fills vector v with inexact real random numbers the sum of whose
;; squares is equal to 1.0.
(random:hollow-sphere! v)

;; Fills vector v with inexact real random numbers that are
;; independent and standard normally distributed (i.e., with mean 0
;; and variance 1).
(random:normal-vector! v)

;; Fills vector v with inexact real random numbers the sum of whose
;; squares is less than 1.0.
(random:solid-sphere! v)

;; Guile's trigonometric functions use radians.

(define pi 3.14159265358979)

(define (degrees->radians deg)
  (* pi (/ deg 180.0)))

(define (radians->degrees rad)
  (* 180.0 (/ rad pi)))

(define (degree-sine deg)
  (sin (degrees->radians deg)))

;; Guile provides the following standard trigonometric functions (and
;; their hyperbolic equivalents), defined for all real and complex
;; numbers:

(sin z)
(cos z)
(tan z)
(asin z)
(acos z)
(atan z)

(acos 3.7)  ; 0.0+1.9826969446812i

;; Guile provides log in base e and 10 natively, defined for any real
;; or complex numbers:

(log z)    ; natural logarithm
(log10 z)  ; base-10 logarithm

;; For other bases, divide by the log of the base:

(define (log-base n z)
  (/ (log z) (log n)))

;; To avoid re-computing (log n) for a base you want to use
;; frequently, you can create a custom log function:

(define (make-log-base n)
  (let ((divisor (log n)))
    (lambda (z) (/ (log z) divisor))))

(define log2 (make-log-base 2))

(log2 1024)

;; In addition to simple vectors, Guile has builtin support for
;; uniform arrays of an arbitrary dimension.

;; a rows x cols integer matrix
(define a (make-array 0 rows cols))
(array-set! a 3 row col)
(array-ref a row col)

;; a 3D matrix of reals
(define b (make-array 0.0 x y z))

;; a literal boolean truth table for logical and
'#2((#f #f) (#f #t))

;; simple matrix multiplication

(define (matrix-mult m1 m2)
  (let* ((d1 (array-dimensions m1))
         (d2 (array-dimensions m2))
         (m1rows (car d1))
         (m1cols (cadr d1))
         (m2rows (car d2))
         (m2cols (cadr d2)))
    (if (not (= m1cols m2rows))
      (error 'index-error "matrices don't match"))
    (let ((result (make-array 0 m1rows m2cols)))
      (do ((i 0 (1+ i)))
          ((= i m1rows))
        (do ((j 0 (1+ j)))
            ((= j m2cols))
          (do ((k 0 (1+ k)))
              ((= k m1cols))
            (array-set! result (+ (array-ref result i j)
                                  (* (array-ref m1 i k)
                                     (array-ref m2 k j)))
                        i j))))
      result)))

(matrix-mult '#2((3 2 3) (5 9 8)) '#2((4 7) (9 3) (8 1)))

;; Guile has builtin support for complex numbers:

(define i 0+1i)       ; 0.0+1.0i
(define i (sqrt -1))  ; 0.0+1.0i

(complex? i)          ; #t
(real-part i)         ; 0.0
(imag-part i)         ; 1.0

(* 3+5i 2-2i)         ; 16+4i
(sqrt 3+4i)           ; 2+i

;; Classic identity:  -e^(pi*i) => 1
(inexact->exact (real-part (- (exp (* pi 0+1i))))) ; 1

;; You can type in literal numbers in alternate radixes:

#b01101101     ; 109 in binary
#o155          ; 109 in octal
#d109          ; 109 in decimal
#x6d           ; 109 in hexadecimal

;; number->string and string->number also take an optional radix:

(define number (string->number hexadecimal 16))
(define number (string->number octal 8))

;; format will also output in different radixes:

(format #t "~B ~O ~D ~X\n" num num num num)

;; converting Unix file permissions read from stdin:

(let loop ((perm (read-line)))
  (cond ((not (eof-object? perm))
         (format #t "The decimal value is ~D\n" (string->number perm 8))
         (loop (read-line)))))

;; once again, format is our friend :)
(use-modules (ice-9 format))

;; the : prefix to the D directive causes commas to be output every
;; three digits.
(format #t "~:D\n" (random 10000000000000000))
; => 2,301,267,079,619,540

;; the third prefix arg to the D directive is the separator character
;; to use instead of a comma, useful for European style numbers:
(format #t "~,,'.:D\n" (random 10000000000000000))
; => 6.486.470.447.356.534

;; the F directive, however, does not support grouping by commas.  to
;; achieve this, we can format the integer and fractional parts
;; separately:
(define (commify num)
  (let ((int (inexact->exact (truncate num))))
    (if (= num int)
      (format #f "~:D" int)
      (string-append (format #f "~:D" int)
                     (let ((str (format #f "~F" num)))
                       (substring str (or (string-index str #\.)
                                          (string-length str))))))))

;; format can handle simple 's' plurals with ~p, and 'y/ies' plurals
;; with the @ prefix:

(format #t "It took ~D hour~P\n" hours hours)

(format #t "It took ~D centur~@P\n" centuries centuries)

(define noun-plural
  (let* ((suffixes '(("ss"  . "sses")
                     ("ph"  . "phes")
                     ("sh"  . "shes")
                     ("ch"  . "ches")
                     ("z"   . "zes")
                     ("ff"  . "ffs")
                     ("f"   . "ves")
                     ("ey"  . "eys")
                     ("y"   . "ies")
                     ("ix"  . "ices")
                     ("s"   . "ses")
                     ("x"   . "xes")
                     ("ius" . "ii")))
        (suffix-match
         (string-append "(" (string-join (map car suffixes) "|") ")$"))
        (suffix-rx (make-regexp suffix-match)))
    (lambda (noun)
      (let ((m (regexp-exec suffix-rx noun)))
        (if m
          (string-append (regexp-substitute #f m 'pre)
                         (cdr (assoc (match:substring m) suffixes)))
          (string-append noun "s"))))))

#!/usr/local/bin/guile -s
!#

;; very naive factoring algorithm
(define (factor n)
  (let ((factors '())
        (limit (inexact->exact (round (sqrt n))))
        (twos 0))
    ;; factor out 2's
    (while (even? n)
           (set! n (ash n -1))
           (set! twos (1+ twos)))
    (if (> twos 0) (set! factors (list (cons 2 twos))))
    ;; factor out odd primes
    (let loop ((i 3))
      (let ((r (remainder n i)))
        (cond ((= r 0)
               (set! n (quotient n i))
               (let* ((old-val (assv i factors))
                      (new-val (if old-val (1+ (cdr old-val)) 1)))
                 (set! factors (assv-set! factors i new-val)))
               (loop i))
              ((< i limit)
               (loop (+ 2 i))))))
    ;; remainder
    (if (> n 1) (set! factors (cons (cons n 1) factors)))
    (reverse! factors)))

;; pretty print a term of a factor
(define (pp-term pair)
  (if (= (cdr pair) 1)
    (number->string (car pair))
    (format #f "~A^~A" (car pair) (cdr pair))))

;; factor each number given on the command line
(for-each
 (lambda (n)
   (let ((factors (factor n)))
     (format #t "~A = ~A" n (pp-term (car factors)))
     (for-each
      (lambda (x) (format #t " * ~A" (pp-term x)))
      (cdr factors))
     (newline)))
 (map string->number (cdr (command-line))))