;;;; streams-math.scm
;;;; Kon Lovett, Apr '09

; 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
; without restriction, including without limitation the rights to use, copy, modify, merge,
; publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to
; whom the Software is furnished to do so, subject to the following conditions: The above
; copyright notice and this permission notice shall be included in all copies or substantial
; portions of the Software.  THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS
; FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF
; CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR
; THE USE OR OTHER DEALINGS IN THE SOFTWARE.


;;;

(module streams-math

  (;export
    stream-max
    stream-min
    stream-sum
    odd-numbers-stream
    even-numbers-stream
    cardinal-numbers-stream
    natural-numbers-stream
    prime-numbers-stream
    hamming-sequence-stream)

  (import
    (except scheme
      max min + < = expt)
    chicken
    (only section-combinators
      left-section)
    (only numbers
      max min + < = expt)
    streams streams-utils)

  (require-library
    section-combinators
    streams streams-utils
    numbers)

  (include "chicken-primitive-object-inlines")
  (include "streams-inlines")

;;;

(define (stream-max strm)
  (stream-fold-one max (%check-stream 'stream-max strm 'stream)) )

(define (stream-min strm)
  (stream-fold-one min (%check-stream 'stream-min strm 'stream)) )

(define stream-sum (left-section stream-fold + 0))

(define odd-numbers-stream (stream-from 1 2))

(define even-numbers-stream (stream-from 0 2))

(define cardinal-numbers-stream (stream-iterate add1 0))

(define natural-numbers-stream (stream-iterate add1 1))

(define-stream (prime-sieve$ strm)
  (define-stream (sift$ base strm)
    (define-stream (next$ base mult strm)
      (let ((first (stream-car strm))
            (rest (stream-cdr strm)))
        (cond
          ((< first mult)
            (stream-cons first (next$ base mult rest)) )
          ((< mult first)
            (next$ base (+ base mult) strm) )
          (else
            (next$ base (+ base mult) rest) ) ) ) )
    (next$ base (+ base base) strm) )
  (let ((first (stream-car strm))
        (rest (stream-cdr strm)))
    (stream-cons first (prime-sieve$ (sift$ first rest))) ) )

(define prime-numbers-stream (prime-sieve$ (stream-from 2)))

#;
(define prime-numbers-stream
  (letrec ((isprime? (lambda (n)
                       (define (iter s)
                         (let ((np (stream-car s)))
                           (cond
                             ((> np (sqrt n))      #t)
                             ((= 0 (modulo n np))  #f)
                             (else                 (iter (stream-cdr s))))))
                       (iter prime-numbers-stream))))
    (stream-cons 2 (stream-filter isprime? (stream-drop 2 natural-numbers-stream)))))

;; http://www.research.att.com/~njas/sequences/A051037

(define hamming-sequence-stream
  (stream-cons 1
    (stream-unique =
      (stream-merge <
        (stream-map (left-section * 2) hamming-sequence-stream)
        (stream-map (left-section * 3) hamming-sequence-stream)
        (stream-map (left-section * 5) hamming-sequence-stream)))) )

#;
(define power-table
  (stream-of
    (stream-of (expt m n) (m in (stream-from 1)))
    (n in (stream-from 2))))

) ;module streams-math