summaryrefslogblamecommitdiffstats
path: root/net/ricketyspace/sicp/one/twelve.scm
blob: 7d315615e4d44353a30f455e7c5a1e2595633691 (plain) (tree)
1
2
3
4



                                                       













                                  
 
                                                 


                            


                          


















                                                  










                                              
                               
                             
;;;; Under Creative Commons Attribution-ShareAlike 4.0
;;;; International. See
;;;; <https://creativecommons.org/licenses/by-sa/4.0/>.

;;;  ____________________________
;;; < pascal's fucking triangle. >
;;; ----------------------------
;;;  \                 __
;;;   \               (--)
;;;    \              (  )
;;;     \             /--\
;;;       __         / \  \
;;;      U--U\.'@@@@@@`.\  )
;;;      \__/(@@@@@@@@@@) /
;;;           (@@@@@@@@)((
;;;           `YY~~~~YY' \\
;;;            ||    ||   >>
;;;

(define-module (net ricketyspace sicp one twelve)
  #:export (compute-triangle
            compute-line
            display-line
            value-at
            print-triangle
            print-line))

(define (compute-triangle n)
  (cond ((= n 1) (list (compute-line n 1)))
        (else (cons (compute-line n 1)
                    (compute-triangle (- n 1))))))

(define (compute-line n pos)
  (cond ((> pos n) '())
        (else
         (cons (value-at n pos)
               (compute-line n (+ pos 1))))))

(define (value-at line pos)
  (cond ((= line 1) 1)
        ((= pos 1) 1)
        ((= line pos) 1)
        (else (+
               (value-at (- line 1) (- pos 1))
               (value-at (- line 1) pos)))))

;;;; printing

(define (print-triangle tl level)
  (cond ((= (length tl) 0) #t)
        (else
         (print-triangle (cdr tl) (+ 1 level))
         (print-line (car tl) level))))

(define (print-line l level)
  (let* ((l (map number->string l))
        (line (string-join l)))
    (format #t "~a\n" line)))