← Back to branch summary

~ubuntu-branches/debian/squeeze/maxima/squeeze

« back to all changes in this revision

Viewing changes to src/flatten.lisp

  • Committer: Bazaar Package Importer
  • Author(s): Camm Maguire
  • Date: 2006-10-18 14:52:42 UTC
  • mto: (1.1.5 upstream)
  • mto: This revision was merged to the branch mainline in revision 4.
  • Revision ID: james.westby@ubuntu.com-20061018145242-vzyrm5hmxr8kiosf
Import upstream version 5.10.0

Show diffs side-by-side

added added

removed removed

Lines of Context:
src/flatten.lisp
1
 
;; Flatten 
2
 
;; Barton Willis
3
 
;; University of Nebraska at Kearney (aka UNK)
4
 
;;    1 Nov 2002
5
 
 
6
 
;; License: GPL
7
 
;; The user of this code assumes all risk for its use. It has no warranty.
8
 
;; If you don't know the meaning of "no warranty," don't use this code. :)
9
 
 
10
 
;; Installation and usage:  Put flatten.lisp in a directory that
11
 
;; Maxima can find.  (Maxima can find files in directories described
12
 
;; in the list file_search_lisp.) To use flatten, begin by loading it.
13
 
 
14
 
;; (C1) load("flatten.lisp")$
15
 
;; (C2) flatten([x=7,[y+x=0,z+1=0], [[x-y=2]]]);
16
 
;; (D2)         [x = 7, y + x = 0, z + 1 = 0, x - y = 2]
17
 
;; (C3) m : matrix([a,b],[c,d])$
18
 
;; (C4) flatten(args(m));
19
 
;; (D4)         [a, b, c, d] 
20
 
 
21
 
;; Flatten is somewhat difficult to define -- essentially it evaluates an 
22
 
;; expression as if its main operator had been declared nary; however, there 
23
 
;; is a difference.  We have
24
 
 
25
 
;; (C1) load("flatten.lisp");
26
 
;; (D1)         flatten.lisp
27
 
;; (C2) flatten(f(g(f(f(x)))));
28
 
;; (D2)         f(g(f(f(x))))
29
 
;; (C3) declare(f,nary);
30
 
;; (D3)         DONE
31
 
;; (C4) ev(d2);
32
 
;; (D4)         f(g(f(x)))
33
 
;; (C5) 
34
 
 
35
 
;; Unlike declaring the main operator of an expression to be nary, flatten 
36
 
;; doesn't recurse into other function arguments.  
37
 
 
38
 
;; This is supposed to be a clone of Macsyma's flatten function.  
39
 
;; Unlike the Macyma version, this version
40
 
;;    (a) handles CRE expressions,
41
 
;;    (b) doesn't try to flatten expressions of the form a^(b^c) -- Macsyma's
42
 
;;        flatten gives an error about a "wrong number of arguments to "^"."
43
 
;;    (c) doesn't try to flatten expressions of the form a=(b=c).
44
 
 
45
 
;; There are other functions other than ^ and = that we shouldn't try
46
 
;; to flatten -- Bessel functions, etc.  
47
 
 
48
 
(in-package "MAXIMA")
49
 
($put '$flatten 1 '$version)
50
 
 
51
 
;; Return the operator and argument of the expression e.
52
 
 
53
 
(defun get-op-and-arg (e)
54
 
  (let ((op) (arg))
55
 
    (cond ((or ($atom e) ($subvarp e))
56
 
           (setq op nil)
57
 
           (setq arg nil))
58
 
          ((and (consp (nth 0 e)) ($subvarp (nth 1 e)))
59
 
           (setq op `(,(nth 0 e) ,(nth 1 e)))
60
 
           (setq arg (cddr e)))
61
 
          (t
62
 
           (setq op (nth 0 e))
63
 
           (setq arg (cdr e))))
64
 
    (values op arg)))
65
 
 
66
 
(defun $flatten (e)
67
 
  (setq e (ratdisrep e))
68
 
  (cond ((or ($atom e) ($subvarp e)(or (member ($inpart e 0) (list '&^ '&=))))
69
 
         e)
70
 
        (t
71
 
         (let ((op (multiple-value-list (get-op-and-arg e))))
72
 
           (setq e (cadr op))
73
 
           (setq op (car op))
74
 
           (setq e (mapcar #'(lambda (x) (flatten-op x op)) e))
75
 
           (setq e (reduce #'append e))
76
 
           (cond ((and (consp (car op)) (eq (caar op) 'mqapply))
77
 
                  (append op e))
78
 
                 (t
79
 
                  `(,op ,@e)))))))
80
 
          
81
 
(defun flatten-op (e op)
82
 
  (let ((e-op) (e-arg))
83
 
    (setq e-op (multiple-value-list (get-op-and-arg e)))
84
 
    (setq e-arg (cadr e-op))
85
 
    (setq e-op (car e-op))
86
 
    (cond ((equal e-op op)
87
 
           (mapcan #'(lambda (x) (flatten-op x op)) e-arg))
88
 
          (t
89
 
           (list e)))))
90
 
           
91
 
           
92
 
 
93
 
 
94
 
 
95
 
 
96
 
        
97
 
 
98
 
              
99
 
               
 
 
b'\\ No newline at end of file'