Paste number 49698: phi

Index of paste annotations: 1 | 2

Paste number 49698: phi
Pasted by: fax
9 months, 1 day ago
#lispcafe | Context in IRC logs
Paste contents:
Raw Source | XML | Display As
MATH-TYPESET> (render-exp '(fraction 1 (operator-sequence 1 + (fraction 1 (operator-sequence 1 + (fraction 1 (operator-sequence 1 + (fraction 1 (operator-sequence 1 + (fraction 1 (operator-sequence 1 + (fraction 1 (operator-sequence 1 + (fraction 1 (operator-sequence 1 + (fraction 1 (operator-sequence 1 + (fraction 1 (operator-sequence 1 + 1)))))))))))))))))))
                  1                  
-------------------------------------
                    1                
    ---------------------------------
                      1              
        -----------------------------
                        1            
            -------------------------
                          1          
                ---------------------
1 +                         1        
    1 +             -----------------
        1 +                   1      
            1 +         -------------
                1 +             1    
                    1 +     ---------
                        1 +       1  
                            1 + -----
                                1 + 1

Annotations for this paste:

Annotation number 1: sqrt(sqrt(sqrt(sqrt(sqrt(sqrt(sqrt(sqrt(sqrt(sqrt(sqrt(sqrt(sqrt(sqrt(sqrt(sqrt(sqrt(sqrt(sqrt(sqrt(sqrt(sqrt(sqrt(....
Pasted by: fax
9 months, 1 day ago
Context in IRC logs
Paste contents:
Raw Source | Display As
MATH-TYPESET> (render-exp '(square-root (square-root (square-root (square-root (square-root (square-root (square-root (square-root (square-root (square-root (square-root (square-root (square-root (square-root (square-root (square-root x)))))))))))))))))
                 ________________________________________________________________________________________________________________________________________
                /                ________________________________________________________________________________________________________________________
               /                /               _________________________________________________________________________________________________________
              /                /               /              ___________________________________________________________________________________________
             /                /               /              /             ______________________________________________________________________________
            /                /               /              /             /            __________________________________________________________________
           /                /               /              /             /            /           _______________________________________________________
          /                /               /              /             /            /           /          _____________________________________________
         /                /               /              /             /            /           /          /         ____________________________________
        /                /               /              /             /            /           /          /         /        ____________________________
       /                /               /              /             /            /           /          /         /        /       _____________________
      /                /               /              /             /            /           /          /         /        /       /      _______________
     /                /               /              /             /            /           /          /         /        /       /      /     __________
    /                /               /              /             /            /           /          /         /        /       /      /     /    ______
   /                /               /              /             /            /           /          /         /        /       /      /     /    /   ___
  /                /               /              /             /            /           /          /         /        /       /      /     /    /   /  _
\/               \/              \/             \/            \/           \/          \/         \/        \/       \/      \/     \/    \/   \/  \/ \/X
NIL

Annotation number 2: anyone want to hack on this?
Pasted by: fax
9 months, 1 day ago
Context in IRC logs
Paste contents:
Raw Source | Display As
(defpackage :math-typeset
  (:use :cl))
(in-package :math-typeset)

(defun devaluefy (function)
  (lambda (&rest parameters)
    (multiple-value-list (apply function parameters))))

(defun valuefy (expression)
  (values-list expression))

(defun tests ()
  (render-exp '(operator-sequence a + (fraction 1 3) + c))
  (render-exp '(square-root 2))
  (render-exp '(fraction (operator-sequence 1 + (square-root 5)) 2))
  (render-exp '(square-root (operator-sequence a + (fraction 1 3) + c)))
  (render-exp '(fraction 1 (square-root (operator-sequence a + b)))))

;; (operator-sequence a + (fraction 1 3) + c)
#||
       1
   A + - + C
       3
            ||#

;; (square-root 2)
#||
     _
   \/2
        ||#

;; (square-root (operator-sequence a + (fraction 1 3) + c))
#||
       __________
      /    1
     / A + - + C
   \/      3
                  ||#

;; (fraction 1 (square-root (operator-sequence a + b))) ->
;; (fraction-square-root 1 (operator-sequence a + b))
#|| ;; TODO
         1
      .------
    \/ A + B
               ||#

(defclass canvas () ((board :initarg :board)))

(defun make-canvas (rows cols)
  (make-instance 'canvas
                 :board (make-array (list cols rows) :initial-element #\space)))

(defun blit (canvas character x y)
  (setf (aref (slot-value canvas 'board) x y) character))

(defun print-canvas (canvas)
  (loop for y from 0 below (array-dimension (slot-value canvas 'board) 1)
        do (loop for x from 0 below (array-dimension (slot-value canvas 'board) 0)
                 do (write-char (aref (slot-value canvas 'board) x y))
                 finally (fresh-line))))


(defclass cell () ())
(defgeneric cell-size (cell))

(defclass atomic (cell)
  ((name :initarg :name)))
(defun make-atomic (name)
  (make-instance 'atomic :name name))
(defmethod cell-size ((cell atomic))
  (values 1 (length (prin1-to-string (slot-value cell 'name)))))
(defmethod blit-to-canvas ((canvas canvas) (cell atomic) x y)
  (let ((str (prin1-to-string (slot-value cell 'name))))
    (loop for ch across str
          for xd from 0 to (length str)
          do (blit canvas ch (+ x xd) y))))

(defclass fraction (cell)
  ((numerator :initarg :numerator)
   (denominator :initarg :denominator)))
(defun make-fraction (numerator denominator)
  (make-instance 'fraction :numerator numerator :denominator denominator))
(defmethod cell-size ((cell fraction))
  (multiple-value-bind (numerator-rows numerator-cols)
      (cell-size (slot-value cell 'numerator))
    (multiple-value-bind (denominator-rows denominator-cols)
        (cell-size (slot-value cell 'denominator))
      (values (+ numerator-rows 1 denominator-rows)
              (max numerator-cols denominator-cols)))))
(defmethod blit-to-canvas ((canvas canvas) (cell fraction) x y)
  (let ((cols (nth-value 1 (cell-size cell)))
        (h1 (nth-value 0 (cell-size (slot-value cell 'numerator)))))
    (let ((numerator-cols (nth-value 1 (cell-size (slot-value cell 'numerator)))))
      (blit-to-canvas canvas (slot-value cell 'numerator)
                      (+ x (floor (- cols numerator-cols) 2))
                      y))
    (loop for xd from 0 below cols do (blit canvas #\- (+ x xd) (+ y h1)))
    (let ((denominator-cols (nth-value 1 (cell-size (slot-value cell 'denominator)))))
      (blit-to-canvas canvas (slot-value cell 'denominator)
                      (+ x (floor (- cols denominator-cols) 2))
                      (+ y h1 1)))))

(defclass operator-sequence (cell)
  ((elements :initarg :elements)))
(defun make-operator-sequence (&rest elements)
  (assert (oddp (length elements)))
  (make-instance 'operator-sequence :elements elements))
(defmethod cell-size ((cell operator-sequence))
  (let ((box-dimensions (mapcar (devaluefy #'cell-size) (slot-value cell 'elements)))
        (number-of-elements (length (slot-value cell 'elements))))
    (values (apply #'max (mapcar #'first box-dimensions))
            (apply #'+ (1- number-of-elements) (mapcar #'second box-dimensions)))))
(defmethod blit-to-canvas ((canvas canvas) (cell operator-sequence) x y)
  (let ((rows (nth-value 0 (cell-size cell))))
    (loop for xd := x then (+ 1 xd (nth-value 1 (cell-size elt)))
          for elt in (slot-value cell 'elements)
          do (let ((elt-rows (nth-value 0 (cell-size elt))))
               (blit-to-canvas canvas elt xd (+ y (ceiling (- rows elt-rows) 2)))))))

(defclass square-root (cell)
  ((parameter :initarg :parameter)))
(defun make-square-root (parameter)
  (make-instance 'square-root :parameter parameter))
(defmethod cell-size ((cell square-root))
  (multiple-value-bind (parameter-rows parameter-cols)
      (cell-size (slot-value cell 'parameter))
    (values (1+ parameter-rows)
            (+ 1 parameter-rows parameter-cols))))
(defmethod blit-to-canvas ((canvas canvas) (cell square-root) x y)
  (multiple-value-bind (parameter-rows parameter-cols)
      (cell-size (slot-value cell 'parameter))
    (blit canvas #\\ (+ x) (+ y parameter-rows))
    (loop for h from 0 below parameter-rows
          do (blit canvas #\/ (+ x (1+ h)) (+ y (- parameter-rows h))))
    (loop for xd from (1+ parameter-rows) to (+ parameter-rows parameter-cols)
          do (blit canvas #\_ (+ x xd) (+ y 0)))
    (blit-to-canvas canvas (slot-value cell 'parameter)
                    (+ x (1+ parameter-rows))
                    (+ y 1))))

(defclass fraction-square-root (cell)
  ((numerator :initarg :numerator)
   (denominator :initarg :denominator)))
(defun make-fraction-square-root (numerator denominator)
  (make-instance 'fraction-square-root :numerator numerator :denominator denominator))
(defmethod cell-size ((cell fraction-square-root))
  )
(defmethod blit-to-canvas ((canvas canvas) (cell fraction-square-root) x y)
  )


(defun maker-for-object (name)
  (ecase name
    (atomic #'make-atomic)
    (fraction #'make-fraction)
    (operator-sequence #'make-operator-sequence)
    (square-root #'make-square-root)
    (fraction-square-root #'make-fraction-square-root)))

(defun matches (expression pattern)
  (cond ((equal '? pattern) t)
        ((atom pattern) (equal expression pattern))
        (t (and (consp expression)
                (matches (car expression) (car pattern))
                (matches (cdr expression) (cdr pattern))))))

(defun exp-macro (exp)
  (cond ((atom exp) exp)
        ((matches exp '(fraction ? (square-root ?)))
         (list 'fraction-square-root (second exp) (second (third exp))))
        (t exp)))

(defun exp->ast (exp)
  (if (atom exp)
      (make-atomic exp)
      (let ((exp (exp-macro exp)))
        (apply (maker-for-object (first exp)) (mapcar #'exp->ast (rest exp))))))

(defun render-exp (exp)
  (let ((ast (exp->ast exp)))
    (multiple-value-bind (rows cols) (cell-size ast)
      (let ((board (make-canvas rows cols)))
        (blit-to-canvas board ast 0 0)
        (print-canvas board)))))

Colorize as:
Show Line Numbers
Index of paste annotations: 1 | 2

Ads absolutely not by Google

Lisppaste pastes can be made by anyone at any time. Imagine a fearsomely comprehensive disclaimer of liability. Now fear, comprehensively.