Diskuze: Common Lisp - derivace

švrčajs

Člen

švrčajs:28.11.2014 2:01

Zdarec, dostal jsem na cvičeních rozpracovaný kód z přednášek a měl jsem ho doplnit, o následující metody.. metody simplify, pro třídy --expr, -expr, /-expr... pak upravit simplify, pro třídu binary-expression, tak aby (representation (simplify (parse '(+ 1 2)))) => 3... tato rozšíření jsem napsal, ale mám problém s třetím rozšířením a to: derivaci zavést jako binární výraz, který by měl jako jeden podvýraz
derivovaný výraz a jako druhý proměnnou, podle které se derivuje (representation (simplify (parse '(d ( x x) x)))) => (* 2 x)
Nemrknul by někdo na to ?

Mnou doplněný kód vypadá takto:

;; -*- mode: lisp; encoding: utf-8; -*-

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;
;;;; OOP - kód k přednášce 13. listopadu 2014
;;;; Algebraické výrazy
;;;;


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; Třída expression
;;;


(defclass expression ()
  ())

;; U metod deriv a expr-subst požadujeme, aby je potomci přepisovali,
;; u representation a simplify ne (zdůvodnění v textu).

(defmethod deriv ((expr expression) var)
  (error "Method deriv has to be rewritten"))

(defmethod expr-subst ((expr expression) var substituent)
  (error "Method expr-subst has to be rewritten"))

(defmethod representation ((expr expression))
  expr)

(defmethod simplify ((expr expression))
  expr)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; Třída const
;;;

(defclass const (expression)
  ((value :initform 0 :initarg :value :reader value)))

(defmethod expr-subst ((expr const) var substituent)
  expr)

(defmethod deriv ((expr const) var)
  (make-instance 'const))

(defmethod representation ((expr const))
  (value expr))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; Třída var
;;;

(defclass var (expression)
  ((name :initform 'x :initarg :name :reader name)))

(defmethod deriv ((expr var) var)
  (make-instance 'const :value (if (eql (name expr)
                                        (name var))
                                   1
                                 0)))

(defmethod expr-subst ((expr var) var substituent)
  (if (eql (name expr)
           (name var))
      substituent
      var))

(defmethod representation ((expr var))
  (name expr))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; Třída binary-expression a potomci
;;;

(defclass binary-expression (expression)
  ((expr-1 :initform (make-instance 'const) :initarg :expr-1 :reader expr-1)
   (expr-2 :initform (make-instance 'const) :initarg :expr-2 :reader expr-2)))

(defmethod expr-subst ((expr binary-expression) var substituent)
  (make-instance (type-of expr)
                 :expr-1 (expr-subst (expr-1 expr) var substituent)
                 :expr-2 (expr-subst (expr-2 expr) var substituent)))
;;;;;;;;;;;;;;pomocí ifu zjistit zdajsou cisla popř. aplikovat bin-expr-symbol expr... ??
(defmethod simplify ((expr binary-expression))
        (if (numberp (expr-1 expr))
                (if (numberp (expr-2 expr))
                        (apply (bin-expr-symbol expr) (expr-1 expr-2)))

        (parse `(,(bin-expr-symbol expr)
           ,(simplify (expr-1 expr))
           ,(simplify (expr-2 expr))))))

(defmethod representation ((expr binary-expression))
  `(,(bin-expr-symbol expr)
    ,(representation (expr-1 expr))
    ,(representation (expr-2 expr))))

(defmethod bin-expr-symbol ((expr binary-expression))
  (error "Method bin-expr-symbol has to be rewritten."))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;++++++++++
(defclass +-expr (binary-expression)
  ())

(defmethod bin-expr-symbol ((expr +-expr))
  '+)

(defmethod zero-const-p ((expr expression))
  nil)

(defmethod zero-const-p ((expr const))
  (zerop (value expr)))

(defmethod simplify ((expr +-expr))
  (let* ((result (call-next-method))
         (expr-1 (expr-1 result))
         (expr-2 (expr-2 result)))
    (cond ((zero-const-p expr-1) expr-2)
          ((zero-const-p expr-2) expr-1)
          (t result))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;--------
(defclass --expr (binary-expression)
  ())

(defmethod bin-expr-symbol ((expr --expr))
  '-)

(defmethod simplify ((expr --expr))
  (let* ((result (call-next-method))
         (expr-1 (expr-1 result))
         (expr-2 (expr-2 result)))
    (cond ((zero-const-p expr-1) expr-2)
          ((zero-const-p expr-2) expr-1)
          (t result))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;******
(defclass *-expr (binary-expression)
  ())

(defmethod bin-expr-symbol ((expr *-expr))
  '*)

(defmethod one-const-p ((e expression))
  nil)

(defmethod one-const-p ((e const))
  (= (value e) 1))

(defmethod simplify ((expr *-expr))
  (let* ((result (call-next-method))
         (expr-1 (expr-1 result))
         (expr-2 (expr-2 result)))
    (cond ((one-const-p expr-1) expr-2)
          ((one-const-p expr-2) expr-1)
          ((or (zero-const-p expr-1)
               (zero-const-p expr-2)) (parse 0))
          (t result))))

(defmethod deriv ((expr *-expr) var)
  (let ((expr-1 (expr-1 expr))
        (expr-2 (expr-2 expr)))
    (parse `(+ (* ,(deriv expr-1 var) ,expr-2)
               (* ,expr-1 ,(deriv expr-2 var))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;/////////////lib. výraz / 1
(defclass /-expr (binary-expression)
  ())

(defmethod bin-expr-symbol ((expr /-expr))
  '/)
;;;;;;;;;;  otestovat, jestli je čitatel  nil ?(hodí chybu), pak jmenovatel nula(hodí chybu), když je jmenovatel =  1 vratí expr1

(defmethod simplify ((expr /-expr))
  (let* ((result (call-next-method))
         (expr-1 (expr-1 result))
         (expr-2 (expr-2 result)))
    (cond ((one-const-p expr-2) expr-1)
          ((zero-const-p expr-2) (error "Method bin-expr-symbol has to be rewritten.") )  ;;;omezení na nulu jmenovatel...
          (t result))))

(defmethod deriv ((expr /-expr) var)
  (let ((expr-1 (expr-1 expr))
        (expr-2 (expr-2 expr)))
    (parse `(+ (/ ,(deriv expr-1 var) ,expr-2)
               (/ ,expr-1 ,(deriv expr-2 var))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; Funkce parse
;;;

(defvar *const-expr-class* 'const)
(defvar *var-expr-class* 'var)
(defvar *+-expr-class* '+-expr)
(defvar *--expr-class* '--expr)
(defvar **-expr-class* '*-expr)
(defvar */-expr-class* '/-expr)

(defun make-binary-expr (name expr-1 expr-2)
  (make-instance (case name
                   (+ *+-expr-class*)
                   (- *--expr-class*)
                   (* **-expr-class*)
                   (/ */-expr-class*))
                 :expr-1 (parse expr-1)
                 :expr-2 (parse expr-2)))

(defun make-const (value)
  (make-instance *const-expr-class* :value value))

(defun make-var (name)
  (make-instance *var-expr-class* :name name))

(defun parse (repr)
  (typecase repr
    (number (make-const repr))
    (symbol (make-var repr))
    (list (apply 'make-binary-expr repr))
    (expression repr)
    (t (error "Nečitelná reprezentace výrazu"))))


(representation (parse '(* x y)))
(representation (deriv (parse '(* x y)) (parse 'x)))
(representation (simplify (deriv (parse '(* x y)) (parse 'x))))

Odpovědět

28.11.2014 2:01

švrčajs

Člen

švrčajs:3.12.2014 22:13

Zdravím, abych zbytečně nezakládal nové téma, dostal jsem za úkol udělat jednočíselný displej (ten co je na kalkulačkách atd...), pro čísla 0-9 v CS...
Ve škole používáme speciální grafickou knihovnu, kterou napsali členové katedry..
Program už mám napsaný, ale nechce se mi to vykresli do okna, několikrát jsem to kontroloval, odstranil chyby, ale i tak to nejde.. Vím, že to bude asi taky pro vás řekněme neznámé, ale s radostí bych uvítal každý nápad, jak to rozjet.. knihovna se přidá pomocí funkce load, kde se musí načíst soubor init.lisp http://leteckaposta.cz/597262028
a můj výtvor:

(defclass display (picture)
((value :initform 0)))

(defun make-display (value)
  (let ((display (make-instance 'display)))
    (set-value display value)
    display)

;;get
(defmethod value ((display display))
  (slot-value display 'value))
;;aset
(defmethod set-value ((display display) value)
  (labels

      ((border ()
         (let ((border (make-instance 'polygon))
               (A (make-point 0 0))
               (B (make-point 0 250))
               (C (make-point 350 250))
               (D (make-point 250 0)))

           ((set-items border (list A B C D))
            (set-color border :black))
           border))

;zatim obdelniky
       (polygons ()
         (let* ((p1 (make-polygon 20 50 20 150 50 150 50 50))  ;horni
                (p2 (make-polygon 50 50 50 80 150 80 150 50))   ;levej horni
                (p3 (make-polygon 50 120 50 150 150 150 150 120)) ;pravej horni
                (p4 (make-polygon 150 50 150 150 180 150 180 50))  ; střed
                (p5 (make-polygon 180 50 180 80 280 80 280 50)) ;levej dolni
                (p6 (make-polygon 180 120 180 150 280 150 280 120)) ;pravej dolní
                (p7 (make-polygon 280 50 280 150 310 150 310 50));;dolni
                (listPolygons 'nil))
                (unless (and (> value 9) (< value 0))
                (error "Hodnota policka musi byt 0 až 9"))
                (cond ((= value 1) ((set-color p3 :red) (set-color p6 :red)))
                        ((= value 2) ((set-color p1 :red) (set-color p3 :red) (set-color p4 :red) (set-color p5 :red) (set-color p7 :red)))
                        ((= value 3) ((set-color p1 :red) (set-color p3 :red)  (set-color p4 :red) (set-color p6 :red) (set-color p7 :red)))
                        ((= value 4) ((set-color p2 :red) (set-color p4 :red) (set-color p6 :red)))
                        ((= value 5) ((set-color p1 :red) (set-color p2 :red) (set-color p4 :red) (set-color p6 :red) (set-color p7 :red)))
                        ((= value 6) ((set-color p2 :red) (set-color p4 :red) (set-color p5 :red) (set-color p6 :red) (set-color p7 :red)))
                        ((= value 7) ((set-color p1 :red) (set-color p3 :red) (set-color p6 :red)))
                        ((= value 8) ((set-color p1 :red) (set-color p2 :red) (set-color p3 :red) (set-color p4 :red) (set-color p5 :red) (set-color p6 :red) (set-color p7 :red)))
                        ((= value 9) ((set-color p1 :red) (set-color p2 :red) (set-color p3 :red) (set-color p4 :red) (set-color p6 :red)))
                        ((= value 0) ((set-color p1 :red) (set-color p2 :red) (set-color p3 :red) (set-color p5 :red) (set-color p6 :red) (set-color p7 :red))
                        (t (make-instance 'empty-shape))))
               (setf listPolygons (list p1 p2 p3 p4 p5 p6 p7))
               listPolygons)


 (set-items display (list (polygons) (border)))
    (setf (slot-value display 'value) value)
    display))))


(defvar *win*)
(setf *win* (make-instance 'window))

(let ((p (make-instance 'picture))
      (x (make-display 1))

      ((set-items p x)
      (set-shape *win* p)
      (redraw *win*))))

Editováno 3.12.2014 22:14

Nahoru Odpovědět

3.12.2014 22:13

Naučíme tě pracovat na home-office.

Více info »

Děláme co je v našich silách, aby byly zdejší diskuze co nejkvalitnější. Proto do nich také mohou přispívat pouze registrovaní členové. Pro zapojení do diskuze se přihlas. Pokud ještě nemáš účet, zaregistruj se, je to zdarma.

Zobrazeno 2 zpráv z 2.