Continued fraction/Arithmetic/G(matrix ng, continued fraction n1, continued fraction n2): Difference between revisions

Content added Content deleted
Line 1,965: Line 1,965:
(multiple-value-list (floor u v))))
(multiple-value-list (floor u v))))


(defmacro absorb-x-term (ng xsource ix)
(defmacro absorb-x-term (ng xsource)
`(let ((a12 (ng8-a12 ,ng))
`(let ((a12 (ng8-a12 ,ng))
(a1 (ng8-a1 ,ng))
(a1 (ng8-a1 ,ng))
Line 1,974: Line 1,974:
(b2 (ng8-b2 ,ng))
(b2 (ng8-b2 ,ng))
(b (ng8-b ,ng))
(b (ng8-b ,ng))
(term (funcall ,xsource ,ix)))
(term (funcall ,xsource)))
⚫
(setf ,ix (1+ ,ix))
(if term
(if term
(let ((ng^ (ng8 (+ a2 (* a12 term))
(let ((ng^ (ng8 (+ a2 (* a12 term))
Line 1,986: Line 1,985:
;; Replace the x source with one that never
;; Replace the x source with one that never
;; returns a term.
;; returns a term.
(setf ,xsource #'(lambda (i) nil)))))
(setf ,xsource #'no-terms-thunk))))
(setf ,ng (ng8 a12 a1 a12 a1 b12 b1 b12 b1)))))
(setf ,ng (ng8 a12 a1 a12 a1 b12 b1 b12 b1)))))


(defmacro absorb-y-term (ng ysource iy)
(defmacro absorb-y-term (ng ysource)
`(let ((a12 (ng8-a12 ,ng))
`(let ((a12 (ng8-a12 ,ng))
(a1 (ng8-a1 ,ng))
(a1 (ng8-a1 ,ng))
Line 1,998: Line 1,997:
(b2 (ng8-b2 ,ng))
(b2 (ng8-b2 ,ng))
(b (ng8-b ,ng))
(b (ng8-b ,ng))
(term (funcall ,ysource ,iy)))
(term (funcall ,ysource)))
(setf ,iy (1+ ,iy))
(if term
(if term
(let ((ng^ (ng8 (+ a1 (* a12 term)) a12
(let ((ng^ (ng8 (+ a1 (* a12 term)) a12
Line 2,010: Line 2,008:
;; Replace the y source with one that never
;; Replace the y source with one that never
;; returns a term.
;; returns a term.
(setf ysource #'(lambda (i) nil)))))
(setf ysource #'no-terms-thunk))))
(setf ,ng (ng8 a12 a12 a2 a2 b12 b12 b2 b2)))))
(setf ,ng (ng8 a12 a12 a2 a2 b12 b12 b2 b2)))))

(defun cf->thunk (cf)
⚫
(let ((i 0))
#'(lambda ()
(let ((term (cf-ref cf i)))
⚫
(setf i (1+ i))
⚫
term))))

(defun no-terms-thunk ()
nil)


(defun apply-ng8 (ng8 x y)
(defun apply-ng8 (ng8 x y)
(declare (ng8 ng8))
(declare (ng8 ng8))
(let ((ng ng8)
(let ((ng ng8)
(xsource #'(lambda (i) (cf-ref x i)))
(xsource (cf->thunk x))
(ysource #'(lambda (i) (cf-ref y i)))
(ysource (cf->thunk y)))
⚫
(ix 0)
⚫
(iy 0))
(flet
(flet
((main ()
((main ()
Line 2,063: Line 2,069:


when (eq absorb 'x)
when (eq absorb 'x)
do (absorb-x-term ng xsource ix)
do (absorb-x-term ng xsource)


when (eq absorb 'y)
when (eq absorb 'y)
do (absorb-y-term ng ysource iy))))
do (absorb-y-term ng ysource))))


(make-cf #'main))))
(make-cf #'main))))
Retrieved from "https://rosettacode.org/wiki/Continued_fraction/Arithmetic/G(matrix_ng,_continued_fraction_n1,_continued_fraction_n2)"