; chaos.sc ; bash run.sh
(define (f . x) (print x))
(f 1 2 3)
(apply f '(1 2 3))
;'done
(define z (map (lambda (n) (ln n)) (interval 1 10)))
(let ( (port (my-open-output-file (string-append "/tmp/chaos.txt") )) )
(for-each (lambda (x y) (print (list x y) port)) (interval 1 10) z)
(close-output-port port)
)
(system "sed -i -e 's/^(//' -e 's/)$//' /tmp/chaos.txt")
;'done
; test
; set pointsize 2
; show pointsize
; # lt is for color of the points:
; # -1=black 1=red 2=grn 3=blue 4=purple 5=aqua 6=brn 7=orange 8=light-brn
; # pt gives a particular point type: 1=diamond 2=+ 3=square 4=X 5=triangle 6=*
; plot "/tmp/chaos.txt" with points pt 6 lt 3
;
; constant rotating disk with a drawing pen
;
; /
; L / |
; / | y'
; /theta |
; +------------
; \ phi
; \
; sin(theta) = y'/L y' = L sin(theta)
; y = y' = L sin(theta+phi) (if not starting at 0)
;
; [disk] [wave]
; radius L = wave amplitude A
; y' = y
; y = A sin(theta)
; y = A sin(theta+phi) (8.2)
; theta == displacement x
; theta/2pi = x/wavelength (within one wave)
; theta/x = 2pi/wavelength (within one wave)
;
; theta = 2pi x / wavelength => (8.2)
; y = A sin( 2pi x / wavelength + phi ) (8.3)
; constant speed y = A sin( 2pi t / waveperiod + phi ) (8.4)
;
; when you connect a series of such disks, with the base of one disk movable vertically
; by the transmission rod of the other disk, and so on and so forth, with each disk
; progressively smaller. the superposition principle thus implies the transmission rod
; being the physical mechanism of the addition operator. a nice gear train.
; for independent x,y,z motions, you will only need three sets of gear trains.
;
; speed of wave = frequency * wavelength (generic formula)
; (5 beats) * (5cm/beat)
; ---------
; second
;
; = 25cm/second
;
; Waves added in a Fourier analysis usually differ from one another in wavelength (frequency),
; amplitude, and phase (starting angle). A fundamental or basic wave serves as a standard or
; reference. That wave usually is the longest wave available; in practice, it's usually
; the length of the record. The wavelength and frequency corresponding to the basic wave are
; the fundamental wavelength and fundamental frequency.
;
; Even at constant wave amplitude and phase, there can be an infinite number of sinusoidal
; waves of differing wavelengths or frequencies.
; For any designated fundamental frequency, Fourier analysis deals only with special
; subclass of that infinite number of waves. Specifically, it uses only those waves whose
; frequencies are an integer multiple of the fundamental frequency (one times the fundamental
; frequency, two times the fundamental frequency, three times the fundamental frequency,
; and so on). Such a constituent wave is called a "harmonic."
;
; basic simplied assumption: the composite wave takes "unit time" to complete one cycle.
; [ when theta goes from 0 to 2pi, all its patterns are revealed. ]
;
; y = A1 sin(theta) [first harmonic] + A2 sin(2theta) [second harmonic] + A3 sin(3theta) ...
; [ so basically, it's all over when first harmonic finishes its cycle. ]
; [ so the slowest disk corresponds to the first harmonic. ]
;
; y[h] = A[h] sin( h theta + phi[h] ) (h is the harmonic number)
;
; sin(A+B) = cosAsinB + sinAcosB
; (if you take B as dt then you can regard the formula as an iterative version of sine)
; (so for iterative sin you need to keep track previous cosine as well)
;
; y[h] = A[h] cos(h theta) sin(phi[h]) + A[h] sin(h theta) cos(phi[h])
; let Alpha[h] = A[h] sin(phi[h]) Beta[h] = A[h] cos(phi[h])
; these are parameters (or constants) for a particular setup (run).
; the time variable is simply theta varying from 0 to 2pi
;
; y[h] = Alpha[h] cos(h theta) + Beta[h] sin(h theta) [ two parameters for each harmonic ]
;
; y = sum[h=0..N/2] Alpha[h] cos(h theta) + Beta[h] sin(h theta) [ N is the number of terms ]
; y = sum[h=0..N/2] Alpha[h] cos(h 2pi x/lambda) + Beta[h] sin(h 2pi x/lambda)
; y = sum[h=0..N/2] Alpha[h] cos(h 2pi t/period) + Beta[h] sin(h 2pi t/period)
; [ wave-period is the time takes to reach a full pattern. ]
;
; (what is h=0? the baseline?) [Thus, with a dataset of 1001 values, stop at h=500. ]
; [ so any complicated periodic motions in space-time can be described this way. ]
;
; N is odd:
; Alpha[h] = 2/N sum[t=0..N-1] y[n] cos( 2pi h t[n] / N )
; Beta[h] = 2/N sum[t=0..N-1] y[n] sin( 2pi h t[n] / N )
; N is even and h is at N/2:
; Alpha[h] = 1/N sum[t=0..N-1] y[n] cos( 2pi h t[n] / N )
; [ data points are arbitrarily assigned from t[n]=0..N-1 ]
;
; For example: six observations: N = 1 2 3 4 5 6
; t[n] = 0 1 2 3 4 5
; y[n] = 8 20 32 13 10 26
;
; Variance-of-harmonic-number-h = (Alpha[h]^2 + Beta[h]^2)/2
; Variance-of-harmonic-number-h = Alpha[h]^2 (N even, h=N/2)
;
; Variance
; (power) of
; harmonic percent
; h Alpha[h] Beta[h] number h contribution
; fundamental harmonic 1 -1.0 4.62 11.17 14.8
; second harmonic 2 -7.7 -8.08 62.06 82.2
; third harmonic 3 -1.5 (careful) 0 (always 0 for N even) 2.25 3.0
; [ note: h become the only variable when plugging-in the formula. ] 75.48 100.0
;
; y = A1 sin(theta+phi1) [first harmonic] + A2 sin(2theta+phi2) [second harmonic] + ...
; sin(A+B) = cosAsinB + sinAcosB
; y[h] = A[h] sin( h theta + phi[h] ) (h is the harmonic number)
; y[h] = A[h] cos(h theta) sin(phi[h]) + A[h] sin(h theta) cos(phi[h])
; let Alpha[h] = A[h] sin(phi[h]) Beta[h] = A[h] cos(phi[h]) <---------------------
; -1.0 = A1 sin(phi1) 4.62 = A1 cos(phi1)
; 1 = (A1 sin(phi1))^2 21.3444 = (A1 cos(phi1))^2
; 22.3444 = A1^2 * 1 => A1= +-4.726986355 = 4.726986355 (negative radius makes no sense)
;
; now what is the length of the transmission rod?
;
; y = sum[h=0..N/2] Alpha[h] cos(h theta) + Beta[h] sin(h theta) [ N is the number of terms ]
; y = sum[h=0..N/2] Alpha[h] cos(h 2pi x/lambda) + Beta[h] sin(h 2pi x/lambda)
; y = sum[h=0..N/2] Alpha[h] cos(h 2pi t/period) + Beta[h] sin(h 2pi t/period)
; look at these three equations again, it's completely generalized.
; look closer at the variables inside sin() or cos(), the point is that sin-or-cos(h 0..2pi)
; [ theta=0..2pi, x=0..lambda => (2pi x/lambda)=0..2pi, t=0..period => (2pi t/period)=0..2pi ]
; QUESTION:
; 1. when you turn the fundamental disk, is the speed of the paper fixed?
; now, let's say the speed of the disk is not known. the rod transfer y' = y displacement,
; L = A amplitude. this is geometric argument. tie it with y=y'=L sin(theta)=A sin(theta)
; NOTE: we say nothing about the "speed" of theta yet.
; tie horizontal displacement with this assumption: theta/2pi = x/wavelength
; y = A sin( 2pi x / wavelength )
; tie time displacement with this assumption: theta/2pi = t / waveperiod
; y = A sin( 2pi t / waveperiod )
; so with either case the argument is simply that when theta varies from 0 to 2pi
; the paper will produce one wavelength worth of wave magically.
; this is a simple scale (geometrical) argument. let's said lambda=10 meter
; theta [0->2pi] / 2pi = 0 -> 1 = x [0->10] / 10
; if you really need to care about the speed of the paper, let's said the wave takes 20 seconds
; theta [0->2pi] / 2pi = 0 -> 1 = x [0->10] / 10 = t [0..20] / 20
; 10/20 => 1/2 meter/second
; so you will need two parameters or assumptions to determine the speed of the paper.
; 2. now invert the situation, when you move the paper, which way does the disk go?
; clockwise, or counter-clockwise?
; TODO: try constructing a mechanical model in blender.
;
; energy of EM radiation = planck's constant h (Joules-sec) * frequency f (cycles/sec)
; speed of wave = frequency * wavelength (generic formula)
; C = f * lambda
; E = h * f => photon of particular color is entirely fixed
; E = number of rotation of some invisible disk (harmonic)
; E = no wonder it is quantized
;
; NOTE: the whole exercise is basically the decomposition of periodic waves to harmonics.
;
;
; model for population growth (logistic equation)
;
; population is normalized (0..1) (pick some maximum value)
;
; new-x = k x ( 1 - x )
;
; plot( { 1*x*(1-x),2*x*(1-x),3*x*(1-x),4*x*(1-x), 5*x*(1-x) } , x = 0 .. 1);
; two roots at 0,1
; critical point at x=1/2 regardless of k => y=k/4
; => (0 < k < 4, else will produce results outside (0,1))
; the peak of the parabola is k/4.
;
; plot [x=0:1] f(x)=k*x*(1-x),k=1,f(x),k=2,f(x),k=3,f(x),k=4,f(x),k=5,f(x)
; plot [x=0:1] f(x)=k*x*(1-x),k=1,f(x),f(x)=x,f(x)
;
; NOTE: for any k value within the range 0<k<3, the same eventual population materializes,
; no matter what the starting population was
; NOTE: k<=1 -> 0 for all x0
; NOTE: 1<k<3 -> [0..0.667] shortcuts: (k-1)/k or 1-(1/k)
; NOTE: 3<=k<~3.57
; The trajectory's behavior now becomes more and more sensitive to the value of k.
; for k=3.4 it's called a "two point attractor".
; from here on, it gets 4, 8, 16, 32, etc. this is called period doubling.
; The period of the attractor, is the number of points that "attracts."
; The range of stability for any periodicity becomes shorter.
; NOTE: 3.55<~k<=4
; we're in the region generally known as chaos.
; An attractor here can be erratic (chaotic, with infinitely many points) or stable.
;
; another function: new-x = k x^2
;
; NOTE1:
; new-x = k x ( 1 - x ) let x0=(k-1)/k normal(k*((k-1)/k)*(1-(k-1)/k)); => (k-1)/k
; feed attractor you get attractor back. fixed point for interative function.
;
; NOTE2:
; The second strange feature is that a trajectory never gets completely and exactly
; all the way onto an attractor.
;
; All attractors are either nonchaotic or chaotic. Nonchaotic attractors are of three types:
; point, periodic, and toroidal attractors.
; Chaotic or strange attractors, arise only after the onset of chaos.
;
; Periodic attractors turn up not only in the nonchaotic domain but also under chaos.
; There aren't any point or toroidal attractors in the chaotic domain.
;
; issue1: Sensitive dependence on initial conditions (trajectory divergence) (chaotic regime)
; issue2: Computer Inaccuracy and Imprecision (trajectory divergence) (chaotic regime)
;
; Similarities with Other Attractors (true for all attractors)
; - It has an invariant probability distribution. (how to prove this? regardless of x0?)
; - Trajectories on a chaotic attractor do not cross. ???
; - The phase space path of a chaotic trajectory also does a folding maneuver. ???
; - complex, many-layered, usually fractal internal structure
; - elaborate or unusual outer geometry
; - noninteger dimension.
;
; NOTE1:
; One orderly peculiarity within chaos is windows -- zones of k values for which iterations
; from any x0 produce the periodic attractor, instead of a chaotic attractor.
; Regular periodicity within the chaotic regime usually are very narrow. Page 193.
; (for logistic function, after k=3.83 period doubling become 6,12,24, ...)
;
; NOTE2:
; Routes Between Windows and Chaos
; According to Grebogi et al. transitions between order and chaos are reversible, at least
; within the chaotic domain. That is, within critical zones of the control parameter
; (edges of windows), chaos can be created or destroyed, depending on increases or
; decreases in the control parameter. ???
;
; NOTE3: x0 was never an issue.
;
; NOTE4: zones of relatively greater popularity for each k.
; Some authors believe that pure chaos sets in only when the control parameter is at
; a maximum (k=4).
;
; NOTE5: Self-Organization, Complexity, and Emergent Systems (for a given k)
;
; NOTE6: Fractal structure
; All fractals have four common characteristics.
; 1. self-similarity or scale invariance.
; 2. A characteristic number.
; 3. Fractals usually are generated by many repetitions of a given operation.
; 4. Fractals aren't smooth.
;
; Poincare Sections: three diagrams, left, right, both.
; simply make a dot when trajectory cross the paper.
; use geometric (scale) argument to deal with the chaos.
; In summary, there are five advantages to taking a Poincaré section:
; - The pattern might indicate the type of attractor.
; - Information not otherwise available emerges about the attractor's internal structure.
; - The number of coordinates (dimensions) decreases by at least one.
; - The quantity of data to be managed is significantly less.
; - The required computational time and computer capability are much less.
;
; Return Maps:
; Next-Amplitude:
; Difference Plots:
;
; Attractor reconstruction: Page 218.
; Hence, the graphical space for a one-dimensional map is really a pseudo phase space.
; (lag 1, 2, ...)
;
; Chaos theory has developed three different ways to extract and show, graphically,
; the attractor of a nonlinear multivariable system from measurements of just one of
; the variables. Those methods are time-delay, singular system analysis (also known
; as singular value decomposition and by other names), and time derivatives.
; As mentioned, the three methods apply mainly to systems that are low-dimensional.
;
; The topological dimension The topological dimension of a body is 1+the Euclidean
; dimension of the simplest geometric object that can subdivide that body.
;
; Lyapunov exponents: the only rule seems to be the period number.
; k<3
; The gap between neighboring trajectories has followed an exponential law in regard to time.
; The neighboring trajectories have converged toward their mutual attractor.
; The convergence means that gaps decrease with time, so the slope of the line is negative.
; k=3.8
; only short term prediction are possible.
; smaller starting gaps (better measurement) helps somewhat.
;
; NOTE: [ all the numbers are actually undefined in real world. ]
; [ you can never be too sure what number you are seeing or measuring. ]
;
; NOTE: try to bring the energy back in the logistic function, it's accumulating too much energy.
; (define (func x) (* k x (- 1 x)))
; feed 1/numerator into second logistic function, and 1/denominator as feedback?
;
; (define (func1 x)(* k1 x (- 1 x)))
; \/
; /\
; (define (func2 x)(* k2 x (- 1 x)))
;
;; Lyapunov exponents
(newline)
(define k 0.95)
(define x0 0.40)
(define y (logistic x0 k 50))
(define x0 0.41)
(define y1 (logistic x0 k 50))
(define z (map (lambda (x y) (log (- x y))) y y1))
;(define z (map (lambda (x y) (abs (- x y))) y y1))
(let ( (port (my-open-output-file (string-append "/tmp/chaos.txt") )) )
(for-each (lambda (x) (print x port)) z)
(close-output-port port)
)
;'done
; plot "/tmp/chaos.txt"
;; Lyapunov exponents
(newline)
(define k 2.8)
(define x0 0.40)
(define y (logistic x0 k 50))
(define x0 0.41)
(define y1 (logistic x0 k 50))
(define z (map (lambda (x y) (log (- x y))) y y1))
;(define z (map (lambda (x y) (abs (- x y))) y y1))
(let ( (port (my-open-output-file (string-append "/tmp/chaos.txt") )) )
(for-each (lambda (x) (print x port)) z)
(close-output-port port)
)
;'done
; plot "/tmp/chaos.txt"
;; Lyapunov exponents
(newline)
(define k 3.4) ; period two
(define x0 0.6)
(define y (logistic x0 k 50))
(define x0 0.8)
(define y1 (logistic x0 k 50))
(define z (map (lambda (x y) (log (- x y))) y y1))
;(define z (map (lambda (x y) (abs (- x y))) y y1))
(let ( (port (my-open-output-file (string-append "/tmp/chaos.txt") )) )
(for-each (lambda (x) (print x port)) z)
(close-output-port port)
)
y y1
;'done
; plot "/tmp/chaos.txt"
;; Lyapunov exponents
(newline)
(define k 3.4) ; period two
(define x0 0.06)
(define y (logistic x0 k 50))
(define x0 0.08)
(define y1 (logistic x0 k 50))
(define z (map (lambda (x y) (log (- x y))) y y1))
;(define z (map (lambda (x y) (abs (- x y))) y y1))
(let ( (port (my-open-output-file (string-append "/tmp/chaos.txt") )) )
(for-each (lambda (x) (print x port)) z)
(close-output-port port)
)
y y1
;'done
; plot "/tmp/chaos.txt"
;; Lyapunov exponents
(newline)
(define k 3.83) ; period three
(define x0 0.060)
(define y (logistic x0 k 200))
(define x0 0.062)
(define y1 (logistic x0 k 200))
(define z (map (lambda (x y) (log (- x y))) y y1))
;(define z (map (lambda (x y) (abs (- x y))) y y1))
(let ( (port (my-open-output-file (string-append "/tmp/chaos.txt") )) )
(for-each (lambda (x) (print x port)) z)
(close-output-port port)
)
y y1
;'done
; plot "/tmp/chaos.txt"
;; Lyapunov exponents
(newline)
(define k 3.83) ; period three
(define x0 0.001)
(define y (logistic x0 k 200))
(define x0 0.999)
(define y1 (logistic x0 k 200))
(define z (map (lambda (x y) (log (- x y))) y y1))
;(define z (map (lambda (x y) (abs (- x y))) y y1))
(let ( (port (my-open-output-file (string-append "/tmp/chaos.txt") )) )
(for-each (lambda (x) (print x port)) z)
(close-output-port port)
)
y y1
;'done
; plot "/tmp/chaos.txt"
;; Lyapunov exponents
(newline)
(define k 3.83) ; period three
(define x0 0.5)
(define y (logistic x0 k 500))
(define x0 0.7)
(define y1 (logistic x0 k 500))
(define z (map (lambda (x y) (log (- x y))) y y1))
;(define z (map (lambda (x y) (abs (- x y))) y y1))
(let ( (port (my-open-output-file (string-append "/tmp/chaos.txt") )) )
(for-each (lambda (x) (print x port)) z)
(close-output-port port)
)
y y1
;'done
; plot "/tmp/chaos.txt"
;; Lyapunov exponents
(newline)
(define k 3.80)
(define x0 0.06)
(define y (logistic x0 k 20))
(define x0 0.062)
(define y1 (logistic x0 k 20))
(define z (map (lambda (x y) (log (- x y))) y y1))
;(define z (map (lambda (x y) (abs (- x y))) y y1))
(let ( (port (my-open-output-file (string-append "/tmp/chaos.txt") )) )
(for-each (lambda (x) (print x port)) z)
(close-output-port port)
)
y y1
;'done
; plot "/tmp/chaos.txt"
;; Lyapunov exponents
(newline)
(define k 3.80)
(define x0 0.06)
(define y (logistic x0 k 50))
(define x0 0.06002)
(define y1 (logistic x0 k 50))
(define z (map (lambda (x y) (log (- x y))) y y1))
;(define z (map (lambda (x y) (abs (- x y))) y y1))
(let ( (port (my-open-output-file (string-append "/tmp/chaos.txt") )) )
(for-each (lambda (x) (print x port)) z)
(close-output-port port)
)
y y1
;'done
; plot "/tmp/chaos.txt"
(newline)
(define k 3.83) ;; period three attractor
(define x0 0.4)
(define y (logistic x0 k 500))
(let ( (port (my-open-output-file (string-append "/tmp/chaos.txt") )) )
(for-each (lambda (x) (print x port)) y)
(close-output-port port)
)
;'done
; plot "/tmp/chaos.txt"
(newline)
(define k 3.83)
(define x0 0.4)
(define y (logistic x0 k 500))
(define z (cdr y))
(set! y (take (length z) y))
(let ( (port (my-open-output-file (string-append "/tmp/chaos.txt") )) )
(for-each (lambda (x y) (print (list x y) port)) y z)
(close-output-port port)
)
(system "sed -i -e 's/^(//' -e 's/)$//' /tmp/chaos.txt")
;'done
; plot [x=0:1] k=3.83, f(x)=k*x*(1-x),f(x),f(x)=x,f(x),"/tmp/chaos.txt" with points pt 6
(newline)
(define k 0.95) ;; attractor
(define x0 0.4)
(define y (logistic x0 k 50))
(let ( (port (my-open-output-file (string-append "/tmp/chaos.txt") )) )
(for-each (lambda (x) (print x port)) y)
(close-output-port port)
)
;'done
; plot "/tmp/chaos.txt"
(newline)
(define k 0.95)
(define x0 0.4)
(define y (logistic x0 k 50))
(define z (cdr y))
(set! y (take (length z) y))
(let ( (port (my-open-output-file (string-append "/tmp/chaos.txt") )) )
(for-each (lambda (x y) (print (list x y) port)) y z)
(close-output-port port)
)
(system "sed -i -e 's/^(//' -e 's/)$//' /tmp/chaos.txt")
;'done
; plot [x=0:0.4] k=0.95, f(x)=k*x*(1-x),f(x),f(x)=x,f(x),"/tmp/chaos.txt" with points pt 6
(newline)
(define k 1.4) ;; attractor
(define x0 0.1)
(define y (logistic x0 k 50))
(let ( (port (my-open-output-file (string-append "/tmp/chaos.txt") )) )
(for-each (lambda (x) (print x port)) y)
(close-output-port port)
)
;'done
; plot "/tmp/chaos.txt"
(newline)
(define k 1.4)
(define x0 0.1)
(define y (logistic x0 k 50))
(define z (cdr y))
(set! y (take (length z) y))
(let ( (port (my-open-output-file (string-append "/tmp/chaos.txt") )) )
(for-each (lambda (x y) (print (list x y) port)) y z)
(close-output-port port)
)
(system "sed -i -e 's/^(//' -e 's/)$//' /tmp/chaos.txt")
;'done
; plot [x=0:0.4] k=1.4, f(x)=k*x*(1-x),f(x),f(x)=x,f(x),"/tmp/chaos.txt" with points pt 6
(newline)
(define k 2.8) ;; attractor
(define x0 0.1)
(define y (logistic x0 k 50))
(let ( (port (my-open-output-file (string-append "/tmp/chaos.txt") )) )
(for-each (lambda (x) (print x port)) y)
(close-output-port port)
)
;'done
; plot "/tmp/chaos.txt"
(newline)
(define k 2.8)
(define x0 0.1)
(define y (logistic x0 k 50))
(define z (cdr y))
(set! y (take (length z) y))
(let ( (port (my-open-output-file (string-append "/tmp/chaos.txt") )) )
(for-each (lambda (x y) (print (list x y) port)) y z)
(close-output-port port)
)
(system "sed -i -e 's/^(//' -e 's/)$//' /tmp/chaos.txt")
;'done
; plot [x=0:1] k=2.8, f(x)=k*x*(1-x),f(x),f(x)=x,f(x),"/tmp/chaos.txt" with points pt 6
(newline)
(define k 3.4) ;; period two
(define x0 0.01)
(define y (logistic x0 k 100))
(let ( (port (my-open-output-file (string-append "/tmp/chaos.txt") )) )
(for-each (lambda (x) (print x port)) y)
(close-output-port port)
)
;'done
; plot "/tmp/chaos.txt"
(newline)
(define k 3.4)
(define x0 0.01)
(define y (logistic x0 k 100))
(define z (cdr y))
(set! y (take (length z) y))
(let ( (port (my-open-output-file (string-append "/tmp/chaos.txt") )) )
(for-each (lambda (x y) (print (list x y) port)) y z)
(close-output-port port)
)
(system "sed -i -e 's/^(//' -e 's/)$//' /tmp/chaos.txt")
;'done
; plot [x=0:1] k=3.4, f(x)=k*x*(1-x),f(x),f(x)=x,f(x),"/tmp/chaos.txt" with points pt 6
(newline)
(define k 3.5)
(define x0 0.01)
(define y (logistic x0 k 200))
(let ( (port (my-open-output-file (string-append "/tmp/chaos.txt") )) )
(for-each (lambda (x) (print x port)) y)
(close-output-port port)
)
;'done
; plot "/tmp/chaos.txt"
(newline)
(define k 3.5)
(define x0 0.01)
(define y (logistic x0 k 200))
(define z (cdr y))
(set! y (take (length z) y))
(let ( (port (my-open-output-file (string-append "/tmp/chaos.txt") )) )
(for-each (lambda (x y) (print (list x y) port)) y z)
(close-output-port port)
)
(system "sed -i -e 's/^(//' -e 's/)$//' /tmp/chaos.txt")
;'done
; test
; plot [x=0:1] k=3.5, f(x)=k*x*(1-x),f(x),f(x)=x,f(x),"/tmp/chaos.txt" with points pt 6
(newline)
(define k 3.55)
(define x0 0.01)
(define y (logistic x0 k 200))
(let ( (port (my-open-output-file (string-append "/tmp/chaos.txt") )) )
(for-each (lambda (x) (print x port)) y)
(close-output-port port)
)
;'done
; plot "/tmp/chaos.txt"
(newline)
(define k 3.55)
(define x0 0.01)
(define y (logistic x0 k 200))
(define z (cdr y))
(set! y (take (length z) y))
(let ( (port (my-open-output-file (string-append "/tmp/chaos.txt") )) )
(for-each (lambda (x y) (print (list x y) port)) y z)
(close-output-port port)
)
(system "sed -i -e 's/^(//' -e 's/)$//' /tmp/chaos.txt")
;'done
; test
; plot [x=0:1] k=3.55, f(x)=k*x*(1-x),f(x),f(x)=x,f(x),"/tmp/chaos.txt" with points pt 6
(newline)
(define k 3.75)
(define x0 0.01)
(define y (logistic x0 k 900))
(let ( (port (my-open-output-file (string-append "/tmp/chaos.txt") )) )
(for-each (lambda (x) (print x port)) y)
(close-output-port port)
)
;'done
; plot "/tmp/chaos.txt"
(newline)
(define k 3.75)
(define x0 0.01)
(define y (logistic x0 k 900))
(define z (cdr y))
(set! y (take (length z) y))
(let ( (port (my-open-output-file (string-append "/tmp/chaos.txt") )) )
(for-each (lambda (x y) (print (list x y) port)) y z)
(close-output-port port)
)
(system "sed -i -e 's/^(//' -e 's/)$//' /tmp/chaos.txt")
;'done
; plot [x=0:1] k=3.75, f(x)=k*x*(1-x),f(x),f(x)=x,f(x),"/tmp/chaos.txt" with points pt 6
;; (logistic x0 k n)
(newline)
(define k 1)
(define x0 0.1)
(logistic x0 k 0)
(logistic x0 k 1)
(logistic x0 k 2)
(logistic x0 k 3)
(logistic x0 k 4)
;'done
(newline)
(define k 1)
(define x0 0.1)
(define y (logistic x0 k 3))
(define z (cdr y))
(set! y (take (length z) y))
y z
;'done
(newline)
(define x (map (lambda (x) (sin (/ (* 2 pi x) 100))) (interval 1 100)))
(define y (map (lambda (x) (cos (/ (* 2 pi x) 100))) (interval 1 100)))
(define sx (standardization x))
(define sy (standardization y))
(let ( (port (my-open-output-file (string-append "/tmp/chaos1.txt") )) )
(for-each (lambda (x) (print x port)) x)
(close-output-port port)
)
(let ( (port (my-open-output-file (string-append "/tmp/chaos2.txt") )) )
(for-each (lambda (x) (print x port)) sx)
(close-output-port port)
)
(let ( (port (my-open-output-file (string-append "/tmp/chaos3.txt") )) )
(for-each (lambda (x) (print x port)) y)
(close-output-port port)
)
(let ( (port (my-open-output-file (string-append "/tmp/chaos4.txt") )) )
(for-each (lambda (x) (print x port)) sy)
(close-output-port port)
)
(length (filter (lambda (x) (> x 1)) sx)) ; 25 out of 100 are out of 1 standard-deviation
(length (filter (lambda (x) (> x 1)) sy)) ; 25 out of 100 are out of 1 standard-deviation
(length (filter prime? (interval 1 100))) ; 25
;'done
; plot "/tmp/chaos1.txt","/tmp/chaos2.txt"
; plot "/tmp/chaos3.txt","/tmp/chaos4.txt"
(define x (map (lambda (x) (sin (/ (* 2 pi x) 1000))) (interval 1 1000)))
(define y (map (lambda (x) (cos (/ (* 2 pi x) 1000))) (interval 1 1000)))
(define sx (standardization x))
(define sy (standardization y))
(length (filter (lambda (x) (> x 1)) sx)) ; 250 out of 1000 are out of 1 standard-deviation
(length (filter (lambda (x) (> x 1)) sy)) ; 250 out of 1000 are out of 1 standard-deviation
(length (filter prime? (interval 1 1000))) ; 168
;'done
(newline)
(define x (list 8 20 32 13 10 26))
(map-print (Fourier-Transform x))
;'done
(newline)
(define x (map (lambda (x) (sin (/ (* 2 pi x) 200))) (interval 0 200)))
(define y (correlogram x))
(define (f lst) (map (lambda (x) (round (* x 1000000))) lst))
(map-print (take 10 (map f (Fourier-Transform y))))
;'done
(newline)
(define x (map (lambda (x) (sin (/ (* 2 pi x) 201))) (interval 0 201)))
(define y (correlogram x))
(define (f lst) (map (lambda (x) (round (* x 1000000))) lst))
(map-print (take 10 (map f (Fourier-Transform y))))
;'done
(newline)
(define x (map (lambda (x) (sin (/ (* 2 pi x) 201))) (interval 0 201)))
(define y x)
(define (f lst) (map (lambda (x) (round (* x 1000000))) lst))
(map-print (take 10 (map f (Fourier-Transform y))))
;'done
(newline)
(define x (map (lambda (x) (cos (/ (* 2 pi x) 201))) (interval 0 201)))
(define y x)
(define (f lst) (map (lambda (x) (round (* x 1000000))) lst))
(map-print (take 10 (map f (Fourier-Transform y))))
;'done
; NOTE: taking samples for one period is important! else you have to take more harmonics.
(newline)
(define x (map (lambda (x) (cos (/ (* 2 pi x) 201))) (interval 0 301)))
(define y x)
(define (f lst) (map (lambda (x) (round (* x 1000000))) lst))
(map-print (take 10 (map f (Fourier-Transform y))))
;'done
;; NOTE: if you take two periods, the important harmonic shifts down
(newline)
(define x (map (lambda (x) (cos (/ (* 2 pi x) 201))) (interval 0 402)))
(define y x)
(define (f lst) (map (lambda (x) (round (* x 1000000))) lst))
(map-print (take 10 (map f (Fourier-Transform y))))
;'done
;; NOTE: if you take two periods, the important harmonic shifts down
(newline)
(define x (map (lambda (x) (cos (/ (* 2 pi x) 201))) (interval 0 603)))
(define y x)
(define (f lst) (map (lambda (x) (round (* x 1000000))) lst))
(map-print (take 10 (map f (Fourier-Transform y))))
;'done
;; NOTE: taking one and half periods, most contributions are from the first six harmonics
(newline)
(define x (map (lambda (x) (cos (/ (* 2 pi x) 200))) (interval 0 300)))
(define y x)
(define (f lst) (map (lambda (x) (round (* x 1000000))) lst))
(map-print (take 10 (map f (Fourier-Transform y))))
;'done
(newline)
(define h 3)(iota h h -1)
(define h 2)(iota h h -1)
(define h 1)(iota h h -1)
;'done
(newline)
(let ( (port (my-open-output-file (string-append "/tmp/chaos.txt") )) )
(print "123" port)
(close-output-port port)
)
;'done
(let ( (port (my-open-output-file (string-append "/tmp/chaos.txt") )) )
(print "456" port)
(close-output-port port)
)
;'done
;; (hankel n) creates about n/2 lagged lists
(newline)
(hankel (interval 1 6))
(hankel (interval 1 6))
(hankel (interval 1 7))
(hankel (interval 1 8))
(hankel (interval 1 9))
(hankel (interval 1 10))
(hankel (interval 1 11))
(hankel (interval 1 12))
;'done
;; this is taking correlation of first series with all the other lagged series
;; there might be other ways of taking correlations, like cross-correlations...
(newline)
(correlogram (interval 1 10))
(correlogram (interval 1 100))
;'done
;; NOTE: you will need roughly two period to get one period of correlation data
(define x (map (lambda (x) (sin (/ x 100))) (interval 1 1280)))
(define y (correlogram x))
(length x)
(length y) ;; should be about half
(let ( (port (my-open-output-file (string-append "/tmp/chaos-" interpreter ".txt") )) )
(for-each (lambda (x) (print x port)) y)
(close-output-port port)
)
;'done
; plot "/tmp/chaos-petite.txt","/tmp/chaos-gambit.txt","/tmp/chaos-mzscheme.txt"
;; this is where it all started
;; http://homepages.nyu.edu/~cb125/Lambda/
(newline)
(reduce '(((lambda x (lambda y (x y))) 2) 3))
(reduce '(((lambda x (lambda y (x y))) p) q))
(reduce '((lambda x (+ x 1)) p))
;'done
;(2 3)
;(p q)
;(+ p 1)
;; http://www.maths.uwa.edu.au/research/mathinf/mikesum1
;;
;; phase space = positon (state) space + velocity space
;; state space are usually finite dimensional subspace of (number of measuring devices)
;; state space can be a unit circle (S1) for example.
;; What properties must an object (or thing) have
;; in order to be a state space for a physical system?
;; We can expect to be worried about noise (measurement errors),
;; So we may need to have a probability density
;; function on the state space to describe our expectations.
;; We need to be able to solve systems of ordinary differential equations on the phase space.
;; These properties are of two sorts,
;; The geometric sort give us a space with a way of telling us when the points are close
;; together, and enough structure to be able to talk about smoothness and continuity
;; of maps from R representing the time into it.
;; The algebraic sort consists of the
;; observation that we can add and subtract angles.
;; If we need to we could have a probability density function on a circle (S1).
;; The existence of pdfs requires some sort of notion of a uniform probability measure
;; on the space.
;; We can talk about a smooth curve on a circle (S1) and if a point is moving around the circle
;; we can meaningfully say how fast it is going and in which direction.
;; So the circle (S1) is a perfectly reasonable state space although it is not a vector space
;; nor a subset of a vector space with an interior.
;; Because the circle is one dimensional, the tangent space is two dimensional and we
;; can hope to draw it.
;; You might think that an electron has to be so simple there is nothing much to say
;; about it except where it is and maybe where it is going and how fast. Unfortunately
;; we cannot say those things because the uncertainty principle doesn't let us give
;; a classical specification of the position and the velocity. And even forgetting
;; about these things, an electron has spin. It is the spin I want to mention.
;; Classically, to talk about a spinning globe, we would need to say what the orientation
;; of the axis of spin is and then specify the rate of spin by giving a real number. The
;; orientation would be a point on the 2-sphere. So we would have that, locally at
;; least, a state would be given by two numbers giving the latitude and longitude of
;; the north pole of the axis and a third number giving the velocity. This gives us
;; three real numbers, although the state space is not R^3.
;; Quantum Mechanics uses a totally different space. It asserts that the state of spin
;; of an electron is an element of the Lie Group SU(2).
;; We would all like to know if SU(2) is similar enough to R^n and circle (S1) to be able to do
;; all the things we can do in those spaces. The answer is yes. So it makes a perfectly
;; respectable state space which is just as well.
;; We would all like to know if SU(2) is similar enough to R^n and circle (S1) to be able to do
;; all the things we can do in those spaces. The answer is yes. So it makes a perfectly
;; respectable state space which is just as well.
;; There are several things we use Lie Groups for, but it would be a good start to say
;; that they have all the essential properties we need to use them as state spaces for
;; physical systems. Rn is a Lie Group, for every positive integer n, as is circle (S1).
;; SU(2) is essentially a complex version of circle.
;;
;; examples of Lie Groups:
;; 1. R^n
;; 2. S1 unit circle
;; 3. S3 { [x1,x2,x3,x3] | x1^2+x2^2+x3^2+x4^2=1 }
;; 4. GL(n,R) the set of all invertible n*n real matrices
;; 5. GL(n,C) the set of all invertible n*n complex matrices
;; 6. O(n), the set of n*n orthogonal matrices
;; 7. U(n), the set of n*n unitary (complex) matrices.
;; 8. SO(n), the set of n*n orthogonal matrices with determinant 1
;; 9. SU(n), the set of n*n unitary matrices with determinant 1
;; 10. SE(n), the set of rigid transformations of R^n, rotations and shifts.
;; A.K.A. The Special Euclidean Group.
;; 11. E(n), the set of rigid transformations of R^n, together with the reflections
;;
;; Of particular importance are SU(2) previously mentioned and SO(3) which can also
;; be defined as the space of rotations of R3 about the origin.
;;
;; If A and B are Lie Groups, so is A cross B, the cartesian or direct product.
;;
;; The geometric properties of R are to do with distances and I suppose we should
;; really call the properties of functions from R to R that involve continuity the analytic
;; properties and when they involve differentiabilty the linear algebraic properties. I
;; shall not be that pedantic and will call them all geometric properties. Whereas
;; properties involving addition or multiplication are definitely algebraic. I have to say
;; there is a grey area with some of them because they are actually both.
;;
;; Algebra:
;; Looking at the algebraic properties first we observe that we can add and subtract
;; numbers. If we exclude zero we can also multiply and divide them. A group is a
;; collection of things where it makes sense to multiply and divide any two of them.
;;
;; Recalling the unit circle we see that we can either represent the points by angles, in
;; which case we can add and subtract any two of them, or we can represent them as
;; complex numbers of modulus 1 in which case we can multiply and divide any two of
;; them. So whether we use the term multiply or add is optional, in both cases we take
;; two of the things and do something to produce a third.
;;
;; Generally we use the term (general) addition when the operation commutes.
;; If not, we use multiplication. (These terms I guess are only used in group theory)
;;
;; Geometry:
;; if constraint is linear: we get linear subspace
;; if constraint is differentiable, we get smooth and nice looking, as in the case of S1
;; in the linear case: if we have k independent conditions on n variables we get a linear
;; subspace of dimension n-k from the rank-nullity theorem.
;; if we have k independent smooth constraints on n variables, we get an n-k dimensional object.
;; (locally) we can fit linear spaces to everything.
;; Hence, S1 has dimension one because x^2+y^2=1, and S^n sits in R^(n+1) and has dimension n.
;; An object such as this is called a differentiable manifold or if we can differentiate as
;; many times as we like a smooth minifold.
;; for example:
;; 1. R^n
;; 2. S1 (unit circle)
;; 3. S3
;; 4. GL(n,R) the set of all invertible n*n real matrices regarded as a subset of R^n^2
;; 5. GL(n,C) the set of all invertible n*n complex matrices regarded as a subset of C^n^2
;; 6. O(n), the set of n*n orthogonal matrices regarded as obtained from GL(n,R)
;; by imposing constraints of orthogonality and normality for the columns
;; 7. U(n), the set of n*n unitary (complex) matrices. Regarded as obtained from
;; GL(n,C) by putting on the constraints of orthonormality
;; 8. SO(n), the set of n*n orthogonal matrices with determinant 1
;; 9. SU(n), the set of n*n unitary matrices with determinant 1
;; 10. SE(n), the set of rigid transformations of R^n, rotations and shifts.
;; A.K.A. The Special Euclidean Group.
;; 11. E(n), the set of rigid transformations of R^n, together with the reflections
;; Lie group is a group and also a smooth manifold.
;; if A and B are smooth manifold, so is A cross B
;; maps (between manifolds), if we can differentiate as many times as we wish, they are smooth
;; So a Lie Group is a group with a multiplication and a smooth manifold of some definite
;; dimension such that multiplcation and inversion are smooth maps
;;
;; Now on to Lie Algebra:
;; Lie algebras come from Lie groups by taking the tangent space at the origin.
;; In the case of the cirle we see that this is just R which is certainly an algebra.
;; In the case of the torus (another Lie group, S1 x S1) and think of the possible velocities
;; for any moving point passing through a fixed point on it,
;; it is easy to see that this is just R^2. In general on any real manifold of dimension n,
;; the tangent space is just R^n.
;; But there is a multiplication on it which is not in general obvious.
;; So the Lie algebra is the vector space consisting of the tangent space to a Lie group
;; at the point e (some sort of unit, like 1), together with a rule for multiplying
;; the vectors in the tangent space derived from the Lie Group.
;; The the old days the elements of the Lie algebra were called infinitesimal operators.
;;
;; http://farside.ph.utexas.edu/teaching/qm/lectures/node7.html
;;
;; Quantum Mechanics:
;;
;; Note that we cannot form a new state by superposing a state with itself.
;; For instance, a photon polarized in the y-direction superposed with another photon
;; polarized in the y-direction (with the same energy and momentum) gives the same photon.
;; (identity problem)
;;
;; ket vectors differ from conventional vectors in that their magnitudes,
;; or lengths, are physically irrelevant.
;;
;; no distinction being made between the directions of the ket vectors |A> and -|A>
;; There is, however, one caveat to the above statements.
;; c1 |A> + c2 |A> = (c1+c2) |A>
;; If c_1+c_2 = 0 then the superposition process yields nothing at all: i.e., no state.
;;
;; The absence of a state is represented by the null vector |0> in ket space.
;;
;; The null vector has the fairly obvious property that |0> + |A> = |A>
;;
;; The fact that ket vectors pointing in the same direction (simply a fixed vector)
;; represent the same state relates ultimately to the quantization of matter:
;; i.e., the fact that it comes in irreducible packets called photons, electrons, atoms, etc.
;; (trying to name it was a bad idea to begin with?)
;;
;; If we observe a microscopic system then we either see a state
;; (i.e., a photon, or an atom, or a molecule, etc.) or we see nothing --
;; we can never see a fraction or a multiple of a state.
;; (because probability was already part of the model, i.e. designed in feature)
;;
;; The statement:
;; Suppose that we want to construct a circularly polarized photon state.
;; (Was it like a probabilistic mini solar system? With probabilistic effect on this world?)
;; Thus, a circularly polarized photon is representable by: |B> + i |C>
;; A general elliptically polarized photon is represented by c1 |B> + c2 |C> c1,c2 complex
;;
;; We conclude that a ket space must be a complex vector space if it is to properly
;; represent the mutual interrelations between the possible states of a microscopic system.
;;
;; Linear functional: f(a+b)=f(a)+f(b) f(c*a)=c*f(a)
;; dual vector space: (af)(v)=a f(v) (f+g)(v)=f(v)+g(v)
;; There is a one to one correspondence between the elements of the ket space and
;; those of the related bra space. So, for every element A of the ket space,
;; there is a corresponding element, which it is also convenient to label A, in the bra space.
;; That is, |A> <-dc-> <A| (dual correspondence)
;; There are an infinite number of ways of setting up the correspondence between vectors
;; in a ket space and those in the related bra space. However, only one of these has any
;; physical significance. c1 |A> + c2 |B> <-dc-> c1^* <A| + c2^* <B|
;;
;; Recall that a bra vector is a functional which acts on a general ket vector,
;; and spits out a complex number.
;;
;; moments later: <B|A> = sum( bi^* ai)
;; moments later: <B|A> = <A|B>^*
;; moments later: <A|A> is a real number and <A|A> >=0
;; The equality sign only holds if |A> is the null ket.
;;
;; Two kets are orthogonal if <A|B>=0 (also implies <B|A> =0)
;;
;; define a "normalized ket |A>" = 1/sqrt(<A|A>) |A> => <A~|A~>=1
;;
;; Since |A> and c|A> represent the same physical state,
;; it makes sense to require that all kets corresponding to physical states have unit norms.
;;
;; We have seen that a functional is a machine which inputs a ket vector and
;; spits out a complex number.
;; Consider a somewhat different machine which inputs a ket vector and spits out another
;; ket vector in a deterministic fashion. Mathematicians call such a machine an operator.
;; We are only interested in operators which preserve the linear dependencies of the
;; ket vectors upon which they act. Such operators are termed linear operators.
;; X+Y=Y+X X+(Y+Z)=(X+Y)+Z X(Y|A>)=(XY)|A>=XY|A> X(YZ)=(XY)Z=XYZ (much like matrices)
;;
;; NOTE: <X|Y> -> complex number
;; X|Y> -> vector
;; Consider <B|X|A> This product is a number which depends linearly on |A>
;; Thus it is maybe consider to be the inner product of |A> with some some bra.
;; This bra depends linearly on <B|, so we may look on it as the result of
;; some linear operator applied to <B|. The equation which defines this vector is
;; ( <B|X ) |A> = <B| ( X|A> ) for any |A> and <B|.
;;
;; |B><A| ? moments later, |B> <A|C> = <A|C> |B> because <A|C> is just a number.
;; Clearly, the product is a linear operator. This operator also acts on bras.
;; transpose(|B><A|)=|A><B|
;;
;; eigenkets of operator X. X|x>=x|x> (how do you "collapse" a matrix into a number?)
;; The eigenvalues are all real numbers, and the eigenkets corresponding to
;; different eigenvalues are orthogonal.
;; dual equation: <y|X = y^* <y|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; http://scottaaronson.com/democritus/lec9.html
;;
;; An event with N possible outcomes, We can express the probabilities
;; of those events by a vector of N real numbers: (p1, ... ,pn) and they sum to 1.
;;
;; let say the system has only 1-bit of information. (two possible outcomes)
;; In probability theory, we can describe a bit as having a probability p of being 0,
;; and a probability 1-p of being 1. (p, 1-p)
;; But if we switch to 2-norm, we now want a vector (a, b) where a^2+b^2=1
;; or in general n outcomes, (a1 .. an) and a1^2+a2^2+...+an^2=1
;;
;; The theory we're inventing will somehow have to connect to observation.
;; So, suppose we have a bit that's described by this vector (a,b).
;; Then we'll need to specify what happens if we look at the bit. Well,
;; since it is a bit, we should see either 0 or 1! Furthermore, the probability
;; of seeing 0 and the probability of seeing 1 had better add up to 1.
;; In probability theory, if we have a bit that's represented by the vector (p,1-p),
;; then we can represent any operation on the bit by a stochastic matrix:
;; that is, a matrix of nonnegative real numbers where every column adds up to 1.
;; Indeed, it turns out that a stochastic matrix is the most general sort of matrix
;; that always maps a probability vector to another probability vector.
;;
;; proof:
;;
(newline)
(matrix-mul rational-field '((1/10 2/10 3/10)
(4/10 5/10 6/10)
(5/10 3/10 1/10)) '((2/10)(2/10)(6/10)) )
(matrix-mul rational-field '((1/10 2/10 3/10)
(4/10 5/10 6/10)
(5/10 3/10 1/10)) '((1/10)(8/10)(1/10)) )
(matrix-mul rational-field '((1/10 2/10 3/10)
(4/10 5/10 6/10)
(5/10 3/10 1/10)) '((3/10)(4/10)(3/10)) )
(foldr1 + (flatten1
(matrix-mul rational-field '((1/10 2/10 3/10)
(4/10 5/10 6/10)
(5/10 3/10 1/10)) '((2/10)(2/10)(6/10)) )
))
(foldr1 + (flatten1
(matrix-mul rational-field '((1/10 2/10 3/10)
(4/10 5/10 6/10)
(5/10 3/10 1/10)) '((1/10)(8/10)(1/10)) )
))
(foldr1 + (flatten1
(matrix-mul rational-field '((1/10 2/10 3/10)
(4/10 5/10 6/10)
(5/10 3/10 1/10)) '((3/10)(4/10)(3/10)) )
))
;'done
;((6/25) (27/50) (11/50))
;((1/5) (1/2) (3/10))
;((1/5) (1/2) (3/10))
;1
;1
;1
(newline)
(matrix-mul rational-field '((1/10 2/10 7/10)
(3/10 4/10 1/10)
(4/10 2/10 1/10)
(2/10 2/10 1/10)) '((2/10)(2/10)(6/10)) )
(matrix-mul rational-field '((1/10 2/10 7/10)
(3/10 4/10 1/10)
(4/10 2/10 1/10)
(2/10 2/10 1/10)) '((1/10)(8/10)(1/10)) )
(matrix-mul rational-field '((1/10 2/10 7/10)
(3/10 4/10 1/10)
(4/10 2/10 1/10)
(2/10 2/10 1/10)) '((3/10)(4/10)(3/10)) )
(foldr1 + (flatten1
(matrix-mul rational-field '((1/10 2/10 7/10)
(3/10 4/10 1/10)
(4/10 2/10 1/10)
(2/10 2/10 1/10)) '((2/10)(2/10)(6/10)) )
))
(foldr1 + (flatten1
(matrix-mul rational-field '((1/10 2/10 7/10)
(3/10 4/10 1/10)
(4/10 2/10 1/10)
(2/10 2/10 1/10)) '((1/10)(8/10)(1/10)) )
))
(foldr1 + (flatten1
(matrix-mul rational-field '((1/10 2/10 7/10)
(3/10 4/10 1/10)
(4/10 2/10 1/10)
(2/10 2/10 1/10)) '((3/10)(4/10)(3/10)) )
))
;'done
;((12/25) (1/5) (9/50) (7/50))
;((6/25) (9/25) (21/100) (19/100))
;((8/25) (7/25) (23/100) (17/100))
;1
;1
;1
;; what to do with 3 outcomes -> 4 outcomes ?
;;
;; But now that we've switched from the 1-norm to the 2-norm,
;; we have to ask: what's the most general sort of matrix that always maps a
;; unit vector in the 2-norm to another unit vector in the 2-norm?
;; Well, we call such a matrix a unitary matrix : (for real numbers U^t=U^-1)
;; This is simply Schrodinger's equation right? |X_t+1> = U |X_t>
;; There are so many questions one has to ask when using this model.
;;
;; Qubit: (a,b) a^2+b^2=1 => a|0>+b|1> "ket space is the outcome space"
;; Do I need to enumerate the entire outcome space?
;; So given a qubit, we can transform it by applying any 2-by-2 unitary matrix --
;; and that leads already to the famous effect of quantum interference.
;;
;; evalf(1/sqrt(2));
(newline)
(define x (/ (sqrt 2)))
(define m (list (list x (negate x))(list x x)))
(map-print m)
(map-print (transpose m))
(map-print (inverse rational-field m))
(map-print m)
(+ (square (/ 3 5)) (square (/ 4 5)))
(matrix-mul rational-field m '((3/5)(4/5)))
(+ (square 0.6) (square 0.8))
;'done
;;
;; interfere constructively (both positive)
;; v
;; [ 1/sqrt(2) -1/sqrt(2)]
;; [ 1/sqrt(2) 1/sqrt(2)]
;; ^
;; interfere destructively (both negative)
;; Applying a "randomizing" operation to a "random" state produces a deterministic outcome!
;;
;(define m (list (list x (negate x))(list x x)))
(newline)
(map-print m)
(matrix-mul rational-field m '((1) (0)))
(matrix-mul rational-field (matrix-mul rational-field m m) '((1) (0)))
;'done
(newline)
(list x x)
(list x (negate x))
(newline)
(map-print (outer-product (list x x)))
(newline)
(map-print (outer-product (list x (negate x))))
;'done
;; http://us.metamath.org/
;; http://www.mathsci.appstate.edu/~jlh/primer/hirst.pdf
;; Propositional Calculus
;; propositional connectives:
;; negation: not
;; conjuction: and ^
;; disjuction: or v
;; implication: ->
;; biconditional: <->
;;
;; tautology: last column of truth table all #t
;; contradiction: last column of truth table all #f
;; contingency: last column of truth table contains both #t and #f
;; antecedent: what's to the left of the ->
;; consequent: what's to the right of the ->
;;
;; logically equivalent:
;; two formulas A and B are logically equivalent iff A <-> B is a tautology
;; contrapositive:
;; "P -> Q" is "(not Q) -> (not P)"
;; "a -> ( b v c )" is "(not ( b v c)) -> (not a)"
;; argument: (logically valid) iff (P1 ^ P2 ^ ... ^ Pn) -> Pn+1 is a tautology
;; Modus Ponens: (p ^ (p -> q)) -> q (tautology, p and q can be replaced by any statement)
;;
;; Proof System:
;; (list "axiom" .. "result of Modus Ponens" .. "hypothesis (formula)" .. "lemma" .. theorem)
;; |- L A if A is a theorem
;; G1...Gn |- L A if A can be proved in L from the given formulas G1..Gn
;;
;; Note: all axioms are tautology?
;; Note: Lemmas are proven theorems
;; Note: Hypotheses must be used as stated ...
;;
;; Deduction Theorem:
;; If G1...Gn A |- L B then G1...Gn |- L A->B
;;
;; Let's summarize. To prove P -> Q, we can assume P, deduce Q, and then
;; apply the deduction theorem. (only use it to "package" a theorem into L)
;;
;; Theorem (The Soundness Theorem for L): If |- L A, then A is a tautology
;; Also, if G1..Gn |- L A, then (G1^...^Gn)->A is a tautology
;; Theorem (The Completeness Theorem for L): If A is a tautology then |- L A
;; Also, if (G1^...^Gn)->A is a tautology, then G1...Gn |- L A
;; Theorem (Consistency of L): L is consistent. That is, there is no formula
;; A such that both |- L A and |- L (not A)
;;
;; Truth (|=) and Deduction (|-):
;; Consistency: if |- A then |- ~A is impossible
;; Soundness: |- A implies |= A
;; Completeness: |= A implies |- A
;;
;; this is just Cartesian product
(newline)
(cross-product '((1 2)(3 4)(5 6)))
;'done
(newline)
(make-list (length '(1 2 3)) 1)
(permu (make-list (length '(1 2 3)) 1))
;'done
(newline)
(define (test x . y)
(print (list x y))
)
(test 1)
(test 1 2)
;'done
;; generate all subsets
(newline)
(subsets '())
(subsets '(1))
(subsets '(1 2))
(subsets '(1 2 3))
(subsets '(1 2 3 4) 0)
(subsets '(1 2 3 4) 1)
(subsets '(1 2 3 4) 2)
(subsets '(1 2 3 4) 3)
(subsets '(1 2 3 4) 4)
(subsets '(1 2 3 4))
;'done
;; binary-relation A and B is any subset of AxB
(newline)
(cross-product '((1 2)(3 4)))
(newline)
(map-print (subsets (cross-product '((1 2)(3 4)))))
;'done
;; (domain relation)
;; (range relation)
(newline)
(for-each (lambda (r)
(print (list (domain r) (range r)))
) (subsets (cross-product '((1 2)(3 4)))) )
;'done
(newline)
(for-each (lambda (r)
(print (list (domain r) (range r)))
) (subsets (cross-product '((1 2)(1 2)))) )
;'done
(newline)
(iff #t #t)
(iff #t #f)
(iff #f #t)
(iff #f #f)
(implies #t #t)
(implies #t #f)
(implies #f #t)
(implies #f #f)
;'done
;#t
;#f
;#f
;#t
;#t
;#f
;#t
;#t
(newline)
(map (lambda (p) (implies p p)) (list #t #f))
(cross-product '((0 1) (0 1) (0 1) ) )
(cross-product '((0 1) (0 1) (0 1) (0 1)) )
(bag-of (list (amb-list (list #t #f)) (amb-list (list #t #f)) ))
(cross-product '((#t #f)(#t #f)))
(prop-calc (lambda (p q) (iff (implies p q) (implies (not q) (not p))))
(bag-of (list (amb-list (list #t #f)) (amb-list (list #t #f)) ))
)
(prop-calc (lambda (p q) (iff (implies p q) (implies (not q) (not p))))
(cross-product '((#t #f)(#t #f)))
)
;'done
(newline)
(prop-calc (lambda (p q) (<=> (=> p q) (=> (not q) (not p))))
(cross-product '((#t #f)(#t #f)))
)
;'done
;(#t #t #t #t)
;; http://sakharov.net/sequent.html
(newline)
(for-each (lambda (x)
(if (eval (cons (lambda (A B C D E F) (=> (and A B C) (or D E F))) x))
'() (print x)
)
) (cross-product '((#t #f)(#t #f)(#t #f)(#t #f)(#t #f)(#t #f)) ) )
;'done
;(#t #t #t #f #f #f)
(newline)
(for-each (lambda (x)
(if (eval (cons (lambda (A B C D E) (=> (and A B) (or C D E))) x))
'() (print x)
)
) (cross-product '((#t #f)(#t #f)(#t #f)(#t #f)(#t #f)) ) )
;'done
;(#t #t #f #f #f)
(newline)
(for-each (lambda (x)
(if (eval (cons (lambda (A B C D E) (=> (and A B C) (or D E))) x))
'() (print x)
)
) (cross-product '((#t #f)(#t #f)(#t #f)(#t #f)(#t #f)) ) )
;'done
;(#t #t #t #f #f)
;;
;; Tautologies
;; Definition. A tautology is a compound proposition which is always true.
;; Definition. A contradiction is a compound proposition which is always false.
;;
;; (for-all, there-exists, if a statement is true for all models, "Logical Valid")
;;
(newline)
(map (lambda (x)
(eval (cons (lambda (A B) (<=> (or A B) (=> (not A) B))) x))
) (cross-product '((#t #f)(#t #f)) ) )
(map (lambda (x)
(eval (cons (lambda (A B) (<=> (and A B) (not (=> A (not B))))) x))
) (cross-product '((#t #f)(#t #f)) ) )
(map (lambda (x)
(eval (cons (lambda (A) (<=> (not A) (=> A #f))) x))
) (cross-product '((#t #f)) ) )
;'done
;; single axiom system?
(newline)
(list->set eq? (map (lambda (x)
(eval (cons (lambda (A B C D E F G) (=> (and A B C G) (or D E F G))) x))
) (cross-product '((#t #f)(#t #f)(#t #f)(#t #f)(#t #f)(#t #f)(#t #f)) ) ))
;'done
;; https://archive.ugent.be/handle/1854/4354
(print "-------1------")
(for-each (lambda (x)
(if (eval (cons (lambda (A B C D) (<=> (and (or A C D) (or B C D)) (or (and A B) C D))) x))
'() (print x)
)
) (cross-product '((#t #f)(#t #f)(#t #f)(#t #f)) ) )
(print "--------------")
;'done
(print "-------2------")
(for-each (lambda (x)
(if (eval (cons (lambda (A B C D) (<=> (and (=> (and A C) D) (=> (and B C) D))
(=> (and (or A B) C) D))) x))
'() (print x)
)
) (cross-product '((#t #f)(#t #f)(#t #f)(#t #f)) ) )
(print "--------------")
;'done
(print "-------3------")
(for-each (lambda (x)
(if (eval (cons (lambda (A B C) (<=> (=> B (or A C)) (=> (and (not A) B) C))) x))
'() (print x)
)
) (cross-product '((#t #f)(#t #f)(#t #f)) ) )
(print "--------------")
;'done
(print "-------4------")
(for-each (lambda (x)
(if (eval (cons (lambda (A B C) (<=> (=> (and A B) C) (=> B (or (not A) C)))) x))
'() (print x)
)
) (cross-product '((#t #f)(#t #f)(#t #f)) ) )
(print "--------------")
;'done
(print "-------doa------")
(for-each (lambda (x)
(if (eval (cons (lambda (A B C) (<=> (or A (and B C)) (and (or A B) (or A C)))) x))
'() (print x)
)
) (cross-product '((#t #f)(#t #f)(#t #f)) ) )
(for-each (lambda (x)
(if (eval (cons (lambda (A B C) (<=> (or (and A B) C) (and (or A C) (or B C)))) x))
'() (print x)
)
) (cross-product '((#t #f)(#t #f)(#t #f)) ) )
(for-each (lambda (x)
(if (eval (cons (lambda (A B C D) (<=> (or (and A B) (and C D))
(and (or A C) (or A D) (or B C) (or B D)))) x))
'() (print x)
)
) (cross-product '((#t #f)(#t #f)(#t #f)(#t #f)) ) )
(print "----------------")
;'done
(print "-------r------")
(for-each (lambda (x)
(if (eval (cons (lambda (A B) (<=> (=> A B) (or (not A) B))) x))
'() (print x)
)
) (cross-product '((#t #f)(#t #f)) ) )
(print "--------------")
;'done
(print "-------m------")
(for-each (lambda (x)
(if (eval (cons (lambda (A B C D E) (=> (=> (=> (=> (=> A B)
(=> (not C) (not D))
) C) E)
(=> (=> E A) (=> D A))
)) x))
'() (print x)
)
) (cross-product '((#t #f)(#t #f)(#t #f)(#t #f)(#t #f)) ) )
(print "--------------")
;'done
(newline)
(count-leaves (list 1 2))
(count-leaves (cons 1 2))
(count-leaves '((1 2)3(4(5 6)7)8))
;'done
(newline)
(tree-map square '(6 (1 2) 2 3) )
;(36 (1 4) 4 9)
;'done
(newline)
(gensym)
(gensym)
(gensym)
(gensym "z")
(gensym "z")
(gensym "z")
(gensym)
(gensym "z")
;'done
;; substitute x with y (symbolically)
(newline)
(tree-sub '2 'x '(6 (1 2) 2 3) )
;'done
;;
;; Predicate Calculus
;; statement about variables: A(x) B(x,y,z) Q(n) P(x,y)
;; constants: a_ b_ c_
;; functions: f(x,y,z) map objects to object
;; connectives: and or not => <=>
;; quantifiers: "for-all" "there-exits" (this only makes sense if you have a universe)
;; Quantifier symbols must be followed by a single variable (never a constant or a function).
;;
;; "for-all" x (0*x=0)
;; "for-all" x (x*x-x=0 -> (x=0 or x=1))
;; "for-all" x "there-exits" y (x*y=1)
;;
;; let f(x)=x+1 B(x) means x=0
;; "for-all" x not B(f(x)) : For all natural numbers x, it is not true that x+1=0
;; For all natural numbers x, x+1 != 0
;; "there-exists" x B(f(x)) : There exists a natural number x, such that x+1=0
;; "there-exists" x not B(f(x)) : There exists a natural number x, such that x+1 != 0
;;
;; let the predicate L(x,y) stand for x loves y (or y is loved by x)
;; "for-all" x "for-all" y L(x,y) : Everyone loves everyone
;; "for-all" y "for-all" x L(x,y) : Everyone is loved by everyone
;; "there-exists" x "there-exists" y L(x,y) : Someone loves someone
;; "there-exists" y "there-exists" x L(x,y) : Someone is loved by someone
;; "for-all" x "there-exists" y L(x,y): Every person has someone that they love
;; "for-all" y "there-exists" x L(x,y): Every person has someone who loves them
;; "there-exists" x "for-all" y L(x,y): there is someone who loves all people.
;; "there-exists" y "for-all" x L(x,y): there is someone who is loved by everyone.
;;
;; s(x)=x^2 P(x,y) means x<=y (lambda (x y) (<= x y))
;; For all natural numbers n, n<=n^2: "for-all" x P(x,s(x))
;; "for-all" n (n<=n^2)
;; let N(x) stands for "x is a natural number"
;; "for-all" x (N(x) -> P(x,s(x)))
;;
;; Socrates is a man. All men have ugly feet. Let the universe be the set of all people.
;; U(x):x has ugly feet. M(x):x is a man. s_ be Socrates.
;; The three statements: M(s_) "for-all" x (M(x)->U(x)) U(s_)
;;
;; Each man has a father. f(x): father of x. S(x,y): x and y are the same person.
;; "for-all" x "there-exists" y such that S(y,f(x))
;;
;; Model:
;; 1. a universe
;; 2. interpretations of all predicate symbols (no nonsense allowed)
;; 3. interpretations of all function symbols (must be defined for everything in the universe)
;; 4. interpretations of all constant symbols (must be instance of the universe)
;;
;; Sentence: A formula with no free variable. (you can assign #t or #f given a model M)
;;
;; Suppose that A(x) is a formula with the free variable x.
;; We say that A(x) is true in M if "for-all" x A(x) is true in M
;; We say that A(x) is satisfiable in M if "there-exists" x A(x) is true in M
;; We say that A(x) is false in M if "there-exists" x A(x) is false in M
;; Suppose that A(x,y,z) is a formula with free variables x,y,z.
;; We say that A(x,y,z) is true in M if "for-all" x "for-all" y "for-all" z A(x,y,z) is true
;; satisfiable ... if "there-exists" x "there-exists" y "there-exists" z ... true
;; false ... if "there-exists" x "there-exists" y "there-exists" z ... false
;;
;; a formula is logically valid if it is true is every model.
;; a formula is contradictory if it is false in every model.
;; a formula A logically implies a formula B if the formula A->B is logically valid
;; a formula A is logically equivalent to a formula B if the formula A<->B is logically valid
;;
;; a formula is an instance of a tautology if it is the result of uniformly replacing
;; the statement letters in a propositional tautology with formulas of predicate calculus.
;; for example:
;; p->p is a tautology, so you can substitue any predicate calculus formula with p uniformly
;; A(x)->A(x), "for-all" x "there-exists" y A(x,y) -> "for-all" x "there-exists" y A(x,y)
;;
;; if P is logically valid, then you can tag on any quantifiers before it
;; "for-all" x P, "for-all" y P, "for-all" x "for-all" y P, ...
;; (use "there-exists" in this case, is simply weakening your statement)
;;
;; Summarizing, any instance of a tautology is logically valid. Any formula gotten
;; by stringing quantifiers in front of a logically valid formula is logically valid.
;; Not every logically valid formula is an instance of a tautology. Indeed there are
;; logically valid formulas that simply cannot be built using the techniques of this section.
;;
;; Terms are either variables, constants, or functions applied to terms.
;; (each term returns a single object from the universe)
;;
;; Definition. A term t is free for a variable x in the formula P if x does not
;; occur free within the scope of a quantifier on a variable in t.
;; (can't substitute free variable with some term that has captured variable)
;; (easy, simply rename all captured variable before substitution)
;; (or as long as you don't change the meaning of the formula)
;;
;; We can plug a constant symbol in for (free) x in any formula, and not
;; worry. Note that we only ever plug terms into free occurrences of variables. We
;; never plug terms of any sort into bounded occurrences of variables.
;;
;;
;; http://best.me.berkeley.edu/~aagogino/me290m/s99/Week5c/Week5c.html
;; 1. object variable 2. object constant 3. relation constant 4. function constant
;; (func (t1 t2 ...)) objects -> object
;; (relation (t1 t2 ...)) objects -> #t #f
;; (for-all x P) relation -> #t #f
;;
;; resolution (Conjunctive Normal Form)
;; 1. Eliminate the logical operator =>
;; 2. Reduce the scope of not until each operator applies to a single "atomic sentence"
;; (not (not P)) <=> P
;; (not (and A B)) <=> (or (not A) (not B))
;; (not (or A B)) <=> (and (not A) (not B))
;; (not (for-all x P)) <=> (there-exists x (not P))
;; (not (there-exists x P)) <=> (for-all x (not P))
;; 3. Distinguish Variables
;; (or (for-all x P) (for-all x Q)) => (or (for-all x P) (for-all y Q))
;; 4. Convert to prenex normal form
;; (or (for-all x P) (for-all y Q)) => (for-all x y (or P Q))
;; 5. Eliminate existential quantifiers (Skolemize)
;; (complicated)
;; 6. Eliminate universal quantifiers
;; 7. Convert all logical sentences into conjunctions of disjunctions
;; Associative property of OR: (OR P (OR Q R)) = (OR (OR P Q) R) = (OR P Q R)
;; Associative property of AND (AND P (AND Q R)) = (AND (AND P Q) R) = (AND P Q R)
;; Distributive property: (OR (AND P Q) R) = (AND (OR P R) (OR Q R))
;; 8. Apply And Elimination
;; 9. Standardizing the variables apart
;; Propositional Calculus (L) gives tautologies.
;; Predicate Calculus (K) logically valid formulas.
;; Formulas that are provable in predicate calculus are exactly the logically valid formulas.
;; Given a logically valid formula we can find a proof of it in K,
;; and given a formula that isn't logically valid we can find a model in which it is
;; not true. (both cases might take a long time)
;;
;; Any theory that consists of the axioms of K together with additional (often
;; called non-logical) axioms using predicates and variables from K is called a first
;; order theory.
;;
;; why logic seem logically to us? in a magical world, no one will degree on logic.
;; maybe logic is related to some deep constraint within ourselves, or some physical
;; or universal property (constraint) ?
;; Godel to Balas (truth is not expressible in the same language)
;; But before Bayesian methods can be used, a problem must be developed beyond the "exploratory
;; phase" to the point where it has enough structure to determine all the needed apparatus
;; (a model, sample space, hypothesis space, prior probabilities, sampling distribution).
;; For this purpose, the Principle of Maximum Entropy has at present the clearest theoretical
;; justication and is the most highly developed computationally, with an analytical apparatus as
;; powerful and versatile as the Bayesian one. To apply it we must dene a sample space, but do
;; not need any model or sampling distribution. In eect, entropy maximization creates a model
;; for us out of our data, which proves to be optimal by so many dierent criteria? that it is
;; hard to imagine circumstances where one would not want to use it in a problem where
;; we have a sample space but no model.
;; Bayesian and maximum entropy methods dier in another respect. Both procedures yield
;; the optimal inferences from the information that went into them, but we may choose a model for
;; Bayesian analysis; this amounts to expressing some prior knowledge - or some working
;; hypothesis - about the phenomenon being observed. Usually such hypotheses extend beyond
;; what is directly observable in the data, and in that sense we might say that Bayesian
;; methods are or at least may be speculative. If the extra hypotheses are true, then we expect
;; that the Bayesian results will improve on maximum entropy; if they are false,
;; the Bayesian inferences will likely be worse.
;; But when the information is extremely vague it may be difficult to define any appropriate
;; sample space, and one may wonder whether still more primitive principles than
;; Maximum Entropy can be found. There is room for much new creative thought here
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; logic.sc
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; http://www.cis.temple.edu/~ingargio/cis587/readings/clausal-alg.cl
(newline)
(gensym-init 2)
(unique-quant-variables '(all x (all y (and (P x) (Q y) (all x (all z (R x z))) ))) )
;'done
;(all ?x3 (all ?x4 (and (P ?x3) (Q ?x4) (all ?x5 (all ?x6 (R ?x5 ?x6))))))
(newline)
(define x '(<=> P Q) )
(eliminate-iff x)
;(and (=> P Q) (=> Q P))
(newline)
(define x '(=> P Q) )
(eliminate-implication x)
;(or (not P) Q)
;; (xor A B) <=> (not (or (and A B) (and (not A) (not B))))
(newline)
(define x '(xor A B))
(eliminate-xor x)
;(not (or (and A B) (and (not A) (not B))))
;; (not (not P)) <=> P
;; (not (and A B)) <=> (or (not A) (not B))
;; (not (or A B)) <=> (and (not A) (not B))
;; (not (all x P)) <=> (exist x (not P))
;; (not (exist x P)) <=> (all x (not P))
(newline)
(define x '(not (or (not P) (all z Q))) )
(move-not-inwards x)
(define x '(not (and (not P) (exist z Q))) )
(move-not-inwards x)
;(and P (exist z (not Q)))
;(or P (all z (not Q)))
(newline)
(define (skolemise f) (skolemise- f '() '()))
(define x '(all x (all y (and (P x y) (exist z (not (Q z z)))))) )
(skolemise x)
(define x '(exist w (and (P w) (all x (exist y (exist z (Q w x y z)))))) )
(skolemise x)
;(and (P x y) (not (Q (skolem7 x y) (skolem7 x y))))
;(and (P skolem8) (Q skolem8 x (skolem9 x) (skolem10 x)))
;; (or A (and B C)) <=> (and (or A B) (or A C))
;; (or (and A B) C) <=> (and (or A C) (or B C))
(newline)
(define x '(or A (and B C)))
(distribute-or-over-and x)
(define x '(or (and A B) C))
(distribute-or-over-and x)
;(and (or A B) (or A C))
;(and (or A C) (or B C))
(newline)
(define x '(or (and A B) (and C D)))
(clausal-form- x)
;(and (and (or A C) (or A D)) (and (or B C) (or B D)))
(newline)
(prop-calc (lambda (A B C D) (iff (or (and A B) (and C D))
(and (and (or A C) (or A D)) (and (or B C) (or B D))) ))
(cross-product '((#t #f)(#t #f)(#t #f)(#t #f)) ))
(newline)
(clausal-form-
'(not (=> A (and B (or C (=> D (not (and C (or A (=> D (xor C (<=> C B))))))))))))
(newline)
(prop-calc (lambda (A B C D) (<=>
(not (=> A (and B (or C (=> D (not (and C (or A (=> D (xor C (<=> C B)))))))))))
(and A (and (or (not B) (not C)) (and (or (not B) D) (and (or (not B) C) (and (and
(and (or (not B) (or A (or (not D) (or (not C) (or C B))))) (or (not B) (or A (or
(not D) (or (not C) (or C (not C))))))) (and (or (not B) (or A (or (not D) (or (not C)
(or (not B) B))))) (or (not B) (or A (or (not D) (or (not C) (or (not B) (not C))))))))
(and (or (not B) (or A (or (not D) (or C (or (not C) B))))) (or (not B) (or A (or
(not D) (or C (or (not B) C))))))))))) ))
(cross-product '((#t #f)(#t #f)(#t #f)(#t #f)) ))
(newline)
(define x '(and (or P Q) (and (or P R) (and (or P S) (or P (or T U))))))
(form-clauses x)
(define x '(or (or P Q) R))
(form-clauses x)
;((P Q) (P R) (P S) (P T U))
;((P Q R))
;; clisp
;; (load "clausal-alg.cl")(load "unify-alg.cl")(defun map-print (x) (mapcar 'print x))
(gensym-init)
(newline)
(define exp '(all x (exist y (<=> (P x c) (Q c y)))) )
(print '*******************) (map-print (clausal-form exp))
(print (list 'map-print (list 'convert-to-clause-form (list 'quote
(tree-sub 'not '~ (tree-sub 'and '& exp))))))
;'done
;((not (P ?x4 c)) (Q c (skolem3 ?x4)))
;((not (Q c (skolem3 ?x6))) (P ?x6 c))
; CLISP
;((~ (P ?X4 C)) (Q C (SKOLEM3 ?X4)))
;((~ (Q C (SKOLEM3 ?X5))) (P ?X5 C))
(newline)
(define exp '(all x (all y (=> (P x y) (Q x y)))) )
(print '---------1---------) (map-print (clausal-form exp))
(print (list 'map-print (list 'convert-to-clause-form (list 'quote
(tree-sub 'not '~ (tree-sub 'and '& exp))))))
;'done
;((not (P ?x10 ?x11)) (Q ?x10 ?x11))
; CLISP
;((~ (P ?X8 ?X9)) (Q ?X8 ?X9))
(newline)
(define exp '(all x (all y (=> (not (Q x y)) (not (P x y))))) )
(print '---------2---------) (map-print (clausal-form exp))
(print (list 'map-print (list 'convert-to-clause-form (list 'quote
(tree-sub 'not '~ (tree-sub 'and '& exp))))))
;'done
;((Q ?x16 ?x17) (not (P ?x16 ?x17)))
; CLISP
;((Q ?X12 ?X13) (~ (P ?X12 ?X13)))
(newline)
(define exp '(all x (all y (=> (P x y) (=> (Q x y) (R x y))))) )
(print '---------3---------) (map-print (clausal-form exp))
(print (list 'map-print (list 'convert-to-clause-form (list 'quote
(tree-sub 'not '~ (tree-sub 'and '& exp))))))
;'done
;((not (P ?x22 ?x23)) (not (Q ?x22 ?x23)) (R ?x22 ?x23))
; CLISP
;((~ (P ?X16 ?X17)) (~ (Q ?X16 ?X17)) (R ?X16 ?X17))
(newline)
(define exp '(all x (all y (=> (and (P x y) (Q x y)) (R x y)))) )
(print '---------4---------) (map-print (clausal-form exp))
(print (list 'map-print (list 'convert-to-clause-form (list 'quote
(tree-sub 'not '~ (tree-sub 'and '& exp))))))
;'done
;((not (P ?x28 ?x29)) (not (Q ?x28 ?x29)) (R ?x28 ?x29))
; CLISP
;((~ (P ?X20 ?X21)) (~ (Q ?X20 ?X21)) (R ?X20 ?X21))
(newline)
(define exp '(all x (all y (=> (P x y) (or (Q x y) (R x y))))) )
(print '---------5---------) (map-print (clausal-form exp))
(print (list 'map-print (list 'convert-to-clause-form (list 'quote
(tree-sub 'not '~ (tree-sub 'and '& exp))))))
;'done
;((not (P ?x34 ?x35)) (Q ?x34 ?x35) (R ?x34 ?x35))
; CLISP
;((~ (P ?X24 ?X25)) (Q ?X24 ?X25) (R ?X24 ?X25))
(newline)
(define exp '(all x (all y (=> (P x y) (and (Q x y) (R x y))))) )
(print '---------6---------) (map-print (clausal-form exp))
(print (list 'map-print (list 'convert-to-clause-form (list 'quote
(tree-sub 'not '~ (tree-sub 'and '& exp))))))
;'done
;((not (P ?x40 ?x41)) (Q ?x40 ?x41))
;((not (P ?x44 ?x45)) (R ?x44 ?x45))
; CLISP
;((~ (P ?X28 ?X29)) (Q ?X28 ?X29))
;((~ (P ?X30 ?X31)) (R ?X30 ?X31))
(newline)
(define exp '(all x (all y (=> (or (P x y) (Q x y)) (R x y)))) )
(print '---------7---------) (map-print (clausal-form exp))
(print (list 'map-print (list 'convert-to-clause-form (list 'quote
(tree-sub 'not '~ (tree-sub 'and '& exp))))))
;'done
;((not (P ?x50 ?x51)) (R ?x50 ?x51))
;((not (Q ?x54 ?x55)) (R ?x54 ?x55))
; CLISP
;((~ (P ?X34 ?X35)) (R ?X34 ?X35))
;((~ (Q ?X36 ?X37)) (R ?X36 ?X37))
(newline)
(define exp '(all x (exist y (=> (P x y) (Q x y)))) )
(print '---------8---------) (map-print (clausal-form exp))
(print (list 'map-print (list 'convert-to-clause-form (list 'quote
(tree-sub 'not '~ (tree-sub 'and '& exp))))))
;'done
;((not (P ?x61 (skolem60 ?x61))) (Q ?x61 (skolem60 ?x61)))
; CLISP
;((~ (P ?X41 (SKOLEM40 ?X41))) (Q ?X41 (SKOLEM40 ?X41)))
(newline)
(define exp '(not (all x (exist y (=> (P x y) (Q x y))))) )
(print '---------9---------) (map-print (clausal-form exp))
(print (list 'map-print (list 'convert-to-clause-form (list 'quote
(tree-sub 'not '~ (tree-sub 'and '& exp))))))
;'done
;((P skolem65 ?x66))
;((not (Q skolem65 ?x68)))
; CLISP
;((P SKOLEM44 ?X45))
;((~ (Q SKOLEM44 ?X46)))
(newline)
(define exp '(=> (not (all x (P x))) (exist x (P x))) )
(print '---------10---------) (map-print (clausal-form exp))
(print (list 'map-print (list 'convert-to-clause-form (list 'quote
(tree-sub 'not '~ (tree-sub 'and '& exp))))))
;'done
;((P ?x73) (P skolem72))
; CLISP
;((P ?X50) (P SKOLEM49))
(newline)
(define exp '(<=> (all x (=> (A x) (B x))) (exist x (Q x))) )
(print '---------11---------) (map-print (clausal-form exp))
(print (list 'map-print (list 'convert-to-clause-form (list 'quote
(tree-sub 'not '~ (tree-sub 'and '& exp))))))
;'done
;((A skolem77) (Q skolem78))
;((not (B skolem77)) (Q skolem78))
;((not (Q ?x79)) (not (A ?x80)) (B ?x80))
; CLISP
;((A SKOLEM55) (Q SKOLEM56))
;((~ (B SKOLEM55)) (Q SKOLEM56))
;((~ (Q ?X57)) (~ (A ?X58)) (B ?X58))
(newline)
(define exp '(all x (=> (P x) (and (exist y (Q x y)) (exist y (R x y))))) )
(print '---------12---------) (map-print (clausal-form exp))
(print (list 'map-print (list 'convert-to-clause-form (list 'quote
(tree-sub 'not '~ (tree-sub 'and '& exp))))))
;'done
;((not (P ?x88)) (Q ?x88 (skolem86 ?x88)))
;((not (P ?x90)) (R ?x90 (skolem87 ?x90)))
; CLISP
;((~ (P ?X64)) (Q ?X64 (SKOLEM62 ?X64)))
;((~ (P ?X65)) (R ?X65 (SKOLEM63 ?X65)))
(newline)
(define exp '(=> (A x) (=> (all x (A x)) (A x))) )
(print '---------13---------) (map-print (clausal-form exp))
(print (list 'map-print (list 'convert-to-clause-form (list 'quote
(tree-sub 'not '~ (tree-sub 'and '& exp))))))
;'done
;((not (A x)) (not (A skolem93)) (A x))
; CLISP
;((~ (A X)) (~ (A SKOLEM67)) (A X))
(newline)
(define exp '(=> (all x (A x)) (=> (exist x (A x)) (all x (A x)))) )
(print '---------14---------) (map-print (clausal-form exp))
(print (list 'map-print (list 'convert-to-clause-form (list 'quote
(tree-sub 'not '~ (tree-sub 'and '& exp))))))
;'done
;((not (A skolem97)) (not (A ?x98)) (A ?x99))
; CLISP
;((~ (A SKOLEM71)) (~ (A ?X72)) (A ?X73))
(newline)
(define exp '(=> (=> (all x (A x)) (exist y (C y)))
(=> (exist x (B x)) (=> (all x (A x)) (exist y (C y))))) )
(print '---------15---------) (map-print (clausal-form exp))
(print (list 'map-print (list 'convert-to-clause-form (list 'quote
(tree-sub 'not '~ (tree-sub 'and '& exp))))))
;'done
;((A ?x109) (not (B ?x110)) (not (A skolem107)) (C skolem108))
;((not (C ?x113)) (not (B ?x114)) (not (A skolem107)) (C skolem108))
; CLISP
;((A ?X81) (~ (B ?X82)) (~ (A SKOLEM79)) (C SKOLEM80))
;((~ (C ?X83)) (~ (B ?X84)) (~ (A SKOLEM79)) (C SKOLEM80))
(newline)
(define exp '(=> (all x (exist y (B x y z))) (exist y (B x y z))) )
(print '---------16---------) (map-print (clausal-form exp))
(print (list 'map-print (list 'convert-to-clause-form (list 'quote
(tree-sub 'not '~ (tree-sub 'and '& exp))))))
;'done
;((not (B skolem120 ?x122 z)) (B x skolem121 z))
; CLISP
;((~ (B SKOLEM88 ?X90 Z)) (B X SKOLEM89 Z))
(newline)
(define exp '(=> (all x (exist y (B x y z))) (exist y (B t y z))) )
(print '---------17---------) (map-print (clausal-form exp))
(print (list 'map-print (list 'convert-to-clause-form (list 'quote
(tree-sub 'not '~ (tree-sub 'and '& exp))))))
;'done
;((not (B skolem127 ?x129 z)) (B t skolem128 z))
; CLISP
;((~ (B SKOLEM94 ?X96 Z)) (B T SKOLEM95 Z))
(newline)
(define exp '(=> (all x (=> (all y (B y)) (exist y (C x y))))
(=> (all y (B y)) (all x (exist y (C x y)))) ) )
(print '---------18---------) (map-print (clausal-form exp))
(print (list 'map-print (list 'convert-to-clause-form (list 'quote
(tree-sub 'not '~ (tree-sub 'and '& exp))))))
;'done
;((B ?x140) (not (B skolem138)) (C ?x141 (skolem139 ?x141)))
;((not (C skolem137 ?x144)) (not (B skolem138)) (C ?x145 (skolem139 ?x145)))
; CLISP
;((B ?X106) (~ (B SKOLEM104)) (C ?X107 (SKOLEM105 ?X107)))
;((~ (C SKOLEM103 ?X108)) (~ (B SKOLEM104)) (C ?X109 (SKOLEM105 ?X109)))
(newline)
(define exp '(xor A (xor A (xor A A))) )
(print '---------19---------) (map-print (clausal-form (clausal-form- exp)))
(print (list 'map-print (list 'convert-to-clause-form (list 'quote
(tree-sub 'not '~ (tree-sub 'and '& (clausal-form- exp)))))))
;'done
;((not A) A)
;((not A))
;(A)
(newline)
;; http://www.cs.mu.oz.au/255/lec/subject-pred_unification.pdf
(define exp '(all x (=> (S x) (exist y (and (T y) (E x y))))) )
(print '--------------------) (map-print (clausal-form exp))
(print (list 'map-print (list 'convert-to-clause-form (list 'quote
(tree-sub 'not '~ (tree-sub 'and '& exp))))))
;'done
;((not (S ?x151)) (T (skolem150 ?x151)))
;((not (S ?x153)) (E ?x153 (skolem150 ?x153)))
; CLISP
;((~ (S ?X117)) (T (SKOLEM116 ?X117)))
;((~ (S ?X118)) (E ?X118 (SKOLEM116 ?X118)))
(newline)
(define exp '(all x (=> (W x) (S x))) )
(print '--------------------) (map-print (clausal-form exp))
(print (list 'map-print (list 'convert-to-clause-form (list 'quote
(tree-sub 'not '~ (tree-sub 'and '& exp))))))
;'done
;((not (W ?x156)) (S ?x156))
; CLISP
;((~ (W ?X120)) (S ?X120))
(newline)
(define exp '(and (W colin) (D colin)) )
(print '--------------------) (map-print (clausal-form exp))
(print (list 'map-print (list 'convert-to-clause-form (list 'quote
(tree-sub 'not '~ (tree-sub 'and '& exp))))))
;'done
;((W colin))
;((D colin))
; CLISP
;((W COLIN))
;((D COLIN))
(newline)
(define exp '(all z (=> (and (T z) (exist y (and (D y) (E y z)))) (M z))) )
(print '--------------------) (map-print (clausal-form exp))
(print (list 'map-print (list 'convert-to-clause-form (list 'quote
(tree-sub 'not '~ (tree-sub 'and '& exp))))))
;'done
;((not (T ?x160)) (not (D ?x161)) (not (E ?x161 ?x160)) (M ?x160))
; CLISP
;((~ (T ?X124)) (~ (D ?X123)) (~ (E ?X123 ?X124)) (M ?X124))
(newline)
(define exp '(not (exist z (and (T z) (M z)))) )
(print '--------------------) (map-print (clausal-form exp))
(print (list 'map-print (list 'convert-to-clause-form (list 'quote
(tree-sub 'not '~ (tree-sub 'and '& exp))))))
;'done
;((not (T ?x165)) (not (M ?x165)))
; CLISP
;((~ (T ?X126)) (~ (M ?X126)))
(newline)
(define exp '(not (=> A (and B (or C (=> D (not (and C (or A (=> D (xor C (<=> C B))))))))))))
(print '--------------------) (map-print (clausal-form (clausal-form- exp)))
(print (list 'map-print (list 'convert-to-clause-form (list 'quote
(tree-sub 'not '~ (tree-sub 'and '& (clausal-form- exp)))))))
;'done
;(A)
;((not B) (not C))
;((not B) D)
;((not B) C)
;((not B) A (not D) (not C) C B)
;((not B) A (not D) (not C) C)
;((not B) A (not D) (not C) B)
;((not B) A (not D) (not C))
;((not B) A (not D) C)
; CLISP
;(A)
;((~ B) (~ C))
;((~ B) D)
;((~ B) C)
;((~ B) A (~ D) (~ C) C B)
;((~ B) A (~ D) (~ C) C (~ C))
;((~ B) A (~ D) (~ C) (~ B) B)
;((~ B) A (~ D) (~ C) (~ B) (~ C))
;((~ B) A (~ D) C (~ C) B)
;((~ B) A (~ D) C (~ B) C)
;; http://www.cs.mu.oz.au/255/lec/subject-prop_resolution.pdf
;; this is also called conjunctive normal form
(newline)
(define exp '(<=> S (and (not P) (=> (not Q) R))) )
(print '------------------) (map-print (clausal-form exp))
(print (list 'map-print (list 'convert-to-clause-form (list 'quote
(tree-sub 'not '~ (tree-sub 'and '& exp))))))
;'done
;((not S) (not P))
;((not S) Q R)
;(P (not Q) S)
;(P (not R) S)
; CLISP
;((~ S) (~ P))
;((~ S) Q R)
;(P (~ Q) S)
;(P (~ R) S)
;; formulae is the plural of formula
(newline)
(prop-calc (lambda (A B C) (=> (and (or A B) (or (not B) C)) (or A C)) )
(cross-product '((#t #f)(#t #f)(#t #f)) )
)
;'done
;; yes this is tautology
;; Algorithm for establishing formula A is valid
;; put (not A) in conjunctive normal form
;; take set of conjuncts and apply resolution repeatedly
;; if eventually you get (some_P) and (not some_P) then (not A) is unsatisfiable
;; (so A is valid); otherwise A is not valid
(newline)
(define exp '(not (=> (and A B) C)) )
(print '------------------) (map-print (clausal-form exp))
(print (list 'map-print (list 'convert-to-clause-form (list 'quote
(tree-sub 'not '~ (tree-sub 'and '& exp))))))
;'done
;(A)
;(B)
;((not C))
; CLISP
;(A)
;(B)
;((~ C))
(newline)
(define exp '(not (=> (and (and H1 H2) H3) C)) )
(print '------------------) (map-print (clausal-form exp))
(print (list 'map-print (list 'convert-to-clause-form (list 'quote
(tree-sub 'not '~ (tree-sub 'and '& exp))))))
;'done
;(H1)
;(H2)
;(H3)
;((not C))
; CLISP
;(H1)
;(H2)
;(H3)
;((~ C))
(newline)
(define exp '(not (=> (and (and (and H1 H2) H3) H4) C)) )
(print '------------------) (map-print (clausal-form exp))
(print (list 'map-print (list 'convert-to-clause-form (list 'quote
(tree-sub 'not '~ (tree-sub 'and '& exp))))))
;'done
;(H1)
;(H2)
;(H3)
;(H4)
;((not C))
; CLISP
;(H1)
;(H2)
;(H3)
;(H4)
;((~ C))
;; Literal: If 'p' is a propositional symbol (i.e. a symbol denoting a statement),
;; then p and ~p (negation of p) are literals. In other words, a literal refers to
;; a statement that does not have any connectives other than NOT (~).
;; * A positive literal is an atom: p(x), q(x), ...
;; * A negative literal is a negated atom: not p(x), not q(x), ...
;; A clause that has no negative literals is a positive clause and a clause
;; that has no positive literals is a negative clause.
;; http://www.cis.temple.edu/~ingargio/cis587/readings/unify-alg.cl
;; (load "clausal-alg.cl")(load "unify-alg.cl")(defun map-print (x) (mapcar 'print x))
(newline)
(varp '?x) (varp "Ann") (eq? '?x '?y) (eq? '?x '?x)
;'done
;#t
;#f
;#f
;#t
(newline)
(occurs '?X '(F A (G ?X B) C))
(occurs 'X '(F A (G ?X B) C X))
;'done
;#t
;#t
;; these two functions call each other
(newline)
(member 5 '(1 3 5 7 5))
(member 5 '(1))
(member 'A '((not B) A (not D) (not C) C B) )
(member 'B '((not B) A (not D) (not C) C B) )
(member 'C '((not B) A (not D) (not C) C B) )
(member 'D '((not B) A (not D) (not C) C B) )
(member 'not '((not B) A (not D) (not C) C B) )
(member '(not B) '((not B) A (not D) (not C) C B) )
(member '(not D) '((not B) A (not D) (not C) C B) )
(member '(not C) '((not B) A (not D) (not C) C B) )
;'done
;(5 7 5)
;()
;(A (not D) (not C) C B)
;(B)
;(C B)
;()
;()
;((not B) A (not D) (not C) C B)
;((not D) (not C) C B)
;((not C) C B)
;; clisp
;(5 7 5)
;NIL
;(A (NOT D) (NOT C) C B)
;(B)
;(C B)
;NIL
;NIL
;NIL
;NIL
;NIL
(newline)
(set-difference (list 'a 'b 'c 'd) (list 'c 'd 'e 'f) )
;'done
(newline)
(replace-variables '(H (K ?X ?Y) D) '((?X A) (?Y (F B))))
;(H (K A (F B)) D)
(replace-variables '(H (K ?X ?Y) D) '())
;(H (K ?X ?Y) D)
;'done
(newline)
(composition '((?X (F ?Z A)) (?Y (G ?W))) '((?Z B) (?U C)))
;'done
;((?X (F B A)) (?Y (G ?W)) (?Z B) (?U C))
;; NOTE: LISP TREAT () AS FALSE !!! (or '() 1 2 3) => 1
;; NOTE: anything not #f is true (always stop at the first true "value") (unless all #f)
(newline)
(or '() 1 2 3)
(or #t '(1 2 3))
(or '() #t)
(or #f #f)
(or)
;'done
;()
;#t
;()
;#f
;#f
;; NOTE: anything not #t is false (always stop at the last "value") (or the default #t)
(newline)
(and '(1) '(2) '(3))
(and #t 1 2)
(and #f #f)
(and)
;'done
;(3)
;2
;#f
;#t
;; no difference return #f
;; not unifiable return #t
;; else return difference
(newline)
(find-difference '(P A (G ?A B) C) '(P A (G (F C) B) C))
;(?A (F C))
(find-difference '() '())
(find-difference '(1) '(1))
(find-difference '(?x(?y(?z(q)))) '(?x(?y(?z(q)))) )
(find-difference '(?x(?y(?z(x)))) '(?x(?y(?z(q)))) )
(find-difference '(?x(?y(?z(P ?x)))) '(?x(?y(?z(Q x y z)))) )
(find-difference '(?x(?y(?z(P ?x)))) '(?x(?y(?z(P y)))) )
(find-difference '(?x(?y(?z(P ?x)))) '(?x(?y(?z(P ?y)))) )
;'done
;#f
;#f
;#f
;#t
;#t
;(?x y)
;(?x ?y)
(newline)
(subst 2 'x '(1 2 3))
(subst '(1 2) 'x '(1 2 3))
(subst '(1 2) 'x '((1 2) 3))
;'done
;(1 x 3)
;(1 2 3)
;(x 3)
(newline)
(find-difference '(F (G ?X A) (H ?Y) C) '(F ?Z ?X ?Y))
(subst '?Z '(G ?X A) '(F (G ?X A) (H ?Y) C) )
(subst '?Z '(G ?X A) '(F ?Z ?X ?Y) )
;'done
;(?Z (G ?X A))
;(F (G ?X A) (H ?Y) C)
;(F (G ?X A) ?X ?Y)
(newline)
(print '-------------)(map-print (unify '(F (G ?X A) (H ?Y) C) '(F ?Z ?X ?Y) '()))
(print '-------------)(map-print (unify '(P ?x) '(P A) '()) )
(print '-------------)(map-print (unify '(P (F ?x) ?y (G ?y)) '(P (F ?x) ?z (G ?x)) '()) )
(print '-------------)(map-print (unify '(F ?x (G ?y)) '(F (G ?u) (G ?z)) '()) )
(print '-------------)(map-print (unify '(F ?x (G ?y)) '(F (G ?u) (H ?z)) '()) )
(print '-------------)(map-print (unify '(F ?x (G ?x) ?x) '(F (G ?u) (G (G ?z)) ?z) '()) )
(print '-------------)(map-print (unify '(P ?x a) '(P b c) '()) )
(print '-------------)(map-print (unify '(P (f ?x) ?y) '(P a ?w) '()) )
(print '-------------)(map-print (unify '(P ?x c) '(P b c) '()) )
(print '-------------)(map-print (unify '(P (f ?x) ?y) '(P (f a) ?w) '()) )
(print '-------------)(map-print (unify '(P ?x) '(P (f ?x)) '()) )
(print '-------------)(map-print (unify '(f ?x (g ?x)) '(f (h ?y) (g (h ?z))) '()) )
(print '-------------)(map-print (unify '(f ?x ?y (f ?x ?y)) '(f b ?z ?z) '()) )
(print '-------------)(map-print (unify '(f (f ?x ?y) ?y) '(f ?z (g a)) '()) )
(print '-------------)(map-print (unify '() '() '()) )
;'done
;-------------
;((?Z (G (H C) A)) (?X (H C)) (?Y C))
;(F (G (H C) A) (H C) C)
;-------------
;((?x A))
;(P A)
;-------------
;((?y ?x) (?z ?x))
;(P (F ?x) ?x (G ?x))
;-------------
;((?x (G ?u)) (?y ?z))
;(F (G ?u) (G ?z))
;-------------
;()
;()
;-------------
;()
;()
;-------------
;()
;()
;-------------
;()
;()
;-------------
;((?x b))
;(P b c)
;-------------
;((?x a) (?y ?w))
;(P (f a) ?w)
;-------------
;()
;()
;-------------
;((?x (h ?z)) (?y ?z))
;(f (h ?z) (g (h ?z)))
;-------------
;()
;()
;-------------
;((?z (f ?x (g a))) (?y (g a)))
;(f (f ?x (g a)) (g a))
;-------------
;()
;()
(newline)
(print '------------------)
(map (lambda (x)
(apply
(lambda (A B C D) (<=> (not (=> (and A B C) D))
(and A B C (not D))
))
x)
) (cross-product '((#t #f) (#t #f) (#t #f) (#t #f)) ) )
(newline)
(print '------------------)
(map (lambda (x)
(apply
(lambda (A B C D E) (<=> (not (=> (and A B C D) E))
(and A B C D (not E))
))
x)
) (cross-product '((#t #f) (#t #f) (#t #f) (#t #f) (#t #f)) ) )
;'done
;; A literal is simply one term in a clause (a clause are terms or'ed together)
;; {C1, C2}
;; ---------------------------------
;; (C1 - {L}) UNION (C2 - {(NOT L)}) <= call it C
;; Given as premises the clauses C1 and C2, where C1 contains the literal L and C2
;; contains the literal (NOT L), infer the clause C, called the Resolvent of C1 and C2,
;; where C is the union of (C1 - {L}) and (C2 - {(NOT L)})
;;
;; Theorem: The Propositional Calculus with the Resolution Inference Rule is
;; sound and Refutation Complete.
;;
(newline)
;; http://www.cis.temple.edu/~ingargio/cis587/readings
;; http://www.cis.temple.edu/~ingargio/cis587/readings/resolution-alg.cl
;; clisp
;; (load "clausal-alg.cl")(load "unify-alg.cl")(load "resolution-alg.cl")
;; (defun map-print (x) (mapcar 'print x))
;; (unify '(W ?x) '(W c) '())
(print '-------------)(map-print (unify '(W ?x) '(W c) '()) )
;((?x c))
;(W c)
(print '-------------)(map-print (unify '(not (W ?x)) '(not (W c)) '()) )
;((?x c))
;(not (W c))
(print '-------------)(map-print (unify '(W ?x) '(not (W c)) '()) )
;()
;()
(print '-------------)(map-print (unify '(not (W ?x)) '(W c) '()) )
;()
;()
(print '-------------)(map-print (unify '(P) '(P) '()) )
;()
;(P)
(print '-------------)(map-print (unify '(P ?x ?a c d) '(P ?y ?b c d) '()) )
;((?x ?y) (?a ?b))
;(P ?y ?b c d)
(print '-------------)(map-print (unify '(P ?x ?a c d) '(P e f c d) '()) )
;((?x e) (?a f))
;(P e f c d)
(print '-------------)(map-print (unify 'P 'P '()) )
;()
;P
(print '-------------)(map-print (unify 'P 'Q '()) )
;()
;()
;'done
;; so "unify" works with two literals (same predicate symbol) that have the same "sign"
;;
;; (full-binary-resolution '((~ (W ?x))(S ?x)) '((W c)) )
;; => (((S C)))
;; (full-binary-resolution '((~ (rich ?x)) (eligible ?x)) '((~ (play-golf ?y)) (rich ?y)) )
;; => (((ELIGIBLE ?Y) (~ (PLAY-GOLF ?Y))))
;; (full-binary-resolution '(p) '((~ p)) )
;; => (NIL)
;;
(newline)
(put-into-two-bags '( (not P) Q R (not (W ?x)) (S ?x) ) )
;'done
;(((S ?x) R Q) ((W ?x) P))
(newline)
(tree-eq? 'P 'P)
(tree-eq? 'P 'Q)
;'done
;#t
;#f
(newline)
(complement-literals? 'P '(not P) )
(complement-literals? '(not P) 'P )
(complement-literals? '(not (P x y)) '(P x y) )
(complement-literals? '(P x y) '(not (P x y)) )
;'done
; all #t
(newline)
(take-out-complement-literals '((not P)(not Q)(not R)) '(P Q R) )
(take-out-complement-literals '((not (P x))(not (Q y))R) '((P x) (Q y) (not R)) )
(take-out-complement-literals '((not (P x))(not (Q y))(R z)) '((P x) (Q y) (not (R z))) )
;'done
;(() ())
;(() ())
;(() ())
(newline)
(full-binary-resolution '((not (W ?x))(S ?x)) '((W c)) )
(full-binary-resolution '((not (rich ?x)) (eligible ?x)) '((not (play-golf ?y)) (rich ?y)) )
(full-binary-resolution '(p) '((not p)) )
(full-binary-resolution '(p) '(q) )
(full-binary-resolution '((P ?x)(Q ?x ?y)) '((not (P a))(R b ?z)) )
(map-print (full-binary-resolution '((P ?x)(P ?y)) '((not (P ?v))(not (P ?w))) ))
;'done
;(((S c)))
;(((eligible ?x) (not (play-golf ?x))))
;(())
;()
;(((Q a ?y) (R b ?z)))
;(((Q a ?y) (R b ?z)))
;((P ?y) (not (P ?w)))
;((P ?y) (not (P ?v)))
;((P ?x) (not (P ?w)))
;((P ?x) (not (P ?v)))
(newline)
(factoring- '((Q ?y)(P ?x ?y)(P ?v A)) )
(factoring '((Q ?y)(P ?x ?y)(P ?v A)) )
(factoring- '() )
(factoring '() )
;'done
(newline)
;; clause with X and not X
(contains-complements? '(P (not P)) )
(contains-complements? '(P (not Q)) )
(contains-complements? '(P Q R S T) )
(contains-complements? '(P Q R S T (not S)) )
;#t
;#f
;#f
;#t
;'done
(newline)
(print '-------------) (map-print (full-resolution (clausal-form
'(not (=> (all x (all y (A x y))) (all y (all x (A x y)))))
)))
(print '-------------) (map-print (full-resolution (clausal-form
'(not (=> (and (A x) (B x)) (A x)))
)))
(print '-------------) (map-print (full-resolution (clausal-form
'(not (=> (all x (and (A x) (B x))) (all x (A x))))
)))
(print '-------------) (map-print (full-resolution (clausal-form
'(not (=> (all x (A x)) (all x (or (A x) (B x)))))
)))
(print '-------------) (map-print (full-resolution (clausal-form
'(not (=> (all x (=> (A x) (B x))) (=> (all x (A x)) (all x (B x)))))
)))
(print '-------------) (map-print (full-resolution (clausal-form
'(not (=> (all x (B x)) (all x (=> (A x) (B x)))))
)))
(print '-------------) (map-print (full-resolution (clausal-form
'(not (=> (all x (all y (A x y))) (all y (all x (A y x)))))
)))
(print '-------------) (map-print (full-resolution (clausal-form
'(not (=> (all x (or (A x) (B x))) (=> (all x (not (A x))) (all x (B x)))))
)))
(print '-------------) (map-print (full-resolution (clausal-form
'(not (=> (A x) (exist x (A x))))
)))
(print '-------------) (map-print (full-resolution (clausal-form
'(not (all y (=> (A y y) (exist x (A x y)))))
)))
(print '-------------) (map-print (full-resolution (clausal-form
'(not (=> (all x (A x)) (exist x (A x))))
)))
(print '-------------) (map-print (full-resolution (clausal-form
'(not (=> (all y (A y)) (exist x (A x))))
)))
(print '-------------) (map-print (full-resolution (clausal-form
'(not (=> (all x (or (A x) (B x))) (or (all x (A x)) (exist x (B x)))))
)))
(print '-------------) (map-print (full-resolution (clausal-form
'(not (=> (not (exist x (A x))) (all x (not (A x)))))
)))
(print '-------------) (map-print (full-resolution (clausal-form
'(not (=> (all x (not (A x))) (not (exist x (A x)))))
)))
(print '-------------) (map-print (full-resolution (clausal-form
'(not (=> (exist x (not (A x))) (not (all x (A x)))))
)))
(print '-------------) (map-print (full-resolution (clausal-form
'(not (=> (not (all x (A x))) (exist x (not (A x)))))
)))
(print '-------------) (map-print (full-resolution (clausal-form
'(not (=> (exist x (and (A x) (B x))) (exist x (A x))))
)))
(print '-------------) (map-print (full-resolution (clausal-form
'(not (=> (exist x (A x)) (exist x (or (A x) (B x)))))
)))
(print '-------------) (map-print (full-resolution (clausal-form
'(not (=> (exist x (all y (A x y))) (all y (exist x (A x y)))))
)))
(print '-------------) (map-print (full-resolution (clausal-form
'(not (=> (exist x (=> (A x) (B x))) (=> (all x (A x)) (exist x (B x)))))
)))
(print '-------------) (map-print (full-resolution (clausal-form
'(not (=> (exist x (B x)) (exist x (=> (A x) (B x)))))
)))
(print '-------------) (map-print (full-resolution (clausal-form
'(not (=> (not (all x (A x))) (exist x (=> (A x) (B x)))))
)))
(print '-------------) (map-print (full-resolution (clausal-form
'(not (=> (=> (all x (A x)) (exist x (B x))) (exist x (=> (A x) (B x)))))
)))
(print '-------------) (map-print (full-resolution (clausal-form
'(not (=> (all x (A x x)) (all x (exist y (A x y)))))
)))
(print '-------------) (map-print (full-resolution (clausal-form
'(not (all y (exist x (or (not (A y x)) (A y y)))))
)))
(print '-------------) (map-print (full-resolution (clausal-form
'(not (=> (exist x (or (A x) (B x))) (or (exist x (A x)) (exist x (B x)))))
)))
;'done
(newline)
(define C1 '( (not (S ?x)) (T (f ?x)) ) )
(define C2 '( (not (S ?x)) (E ?x (f ?x)) ) )
(define C3 '( (not (W ?x)) (S ?x) ) )
(define C4 '( (W c) ) )
(define C5 '( (D c) ) )
(define C6 '( (not (T ?z)) (not (D ?y)) (not (E ?y ?z)) (M ?z) ) )
(define C7 '( (not (T ?z)) (not (M ?z)) ) )
(define C8 (full-resolution (list C4 C3)) ) (map-print C8) (set! C8 (last C8))
(define C9 (full-resolution (list C8 C1)) ) (map-print C9) (set! C9 (last C9))
(define C10 (full-resolution (list C8 C2)) ) (map-print C10) (set! C10 (last C10))
(define C11 (full-resolution (list C9 C6)) ) (map-print C11) (set! C11 (last C11))
(define C12 (full-resolution (list C10 C11)) ) (map-print C12) (set! C12 (last C12))
(define C13 (full-resolution (list C5 C12)) ) (map-print C13) (set! C13 (last C13))
(define C14 (full-resolution (list C7 C13)) ) (map-print C14) (set! C14 (last C14))
(define C15 (full-resolution (list C9 C14)) ) (map-print C15) (set! C15 (last C15))
;((S c))
;((T (f c)))
;((E c (f c)))
;((not (D ?y)) (not (E ?y (f c))) (M (f c)))
;((not (D c)) (M (f c)))
;((M (f c)))
;((not (T (f c))))
;found
;clause-i
;((T (f c)))
;clause-j
;((not (T (f c))))
;resolution-set
;(())
;'done
(newline)
(print '-------------)(map-print (full-resolution (list C1 C2 C3 C4 C5 C6 C7)))
;;((not (S ?x)) (T (f ?x)))
;;((not (S ?x)) (E ?x (f ?x)))
;;((not (W ?x)) (S ?x))
;;((W c))
;;((D c))
;;((not (T ?z)) (not (D ?y)) (not (E ?y ?z)) (M ?z))
;;((not (T ?z)) (not (M ?z)))
;((S c))
;((T (f c)))
;((E c (f c)))
;((not (M (f c))))
;((T (f ?x)) (not (W ?x)))
;((not (S ?x)) (not (M (f ?x))))
;((E ?x (f ?x)) (not (W ?x)))
;((not (T ?z)) (not (E c ?z)) (M ?z))
;((not (E c (f c))) (M (f c)))
;((M (f c)))
;found
;clause-i
;((not (M (f c))))
;clause-j
;((M (f c)))
;resolution-set
;(())
;'done
(newline)
(print '-------------)(map-print (full-resolution (list
'( (Q ?x) (not (P ?x)) (not (S ?x)) )
'( (P ?x) (not (R ?x)) ) '((R a)) '((R b)) '((S b)) '((not (Q b)))
)))
;;((Q ?x) (not (P ?x)) (not (S ?x)))
;;((P ?x) (not (R ?x)))
;((R a))
;((R b))
;((S b))
;((not (Q b)))
;((P a))
;((P b))
;((Q b) (not (P b)))
;((not (P b)))
;found
;clause-i
;((P b))
;clause-j
;((not (P b)))
;resolution-set
;(())
;'done
(newline)
(print '-------------)(map-print (full-resolution (list
'( (P a b) ) '( (not (P ?x ?y)) (Q ?x ?y) )
'( (not (P ?x ?y)) (Q ?y ?x) ) '( (not (Q b a)) )
)))
;;((P a b))
;;((not (P ?x ?y)) (Q ?x ?y))
;((not (P ?x ?y)) (Q ?y ?x))
;((not (Q b a)))
;((Q a b))
;((Q b a))
;found
;clause-i
;((not (Q b a)))
;clause-j
;((Q b a))
;resolution-set
;(())
;'done
(newline)
(print '-------------) (map-print (full-resolution (clausal-form
'(not (=> (and (P A) (all x (=> (P x) (Q x)))) (Q A)))
)))
;((P A))
;((not (P ?x208)) (Q ?x208))
;((not (Q A)))
;((Q A))
;found
;clause-i
;((not (Q A)))
;clause-j
;((Q A))
;resolution-set
;(())
;'done
(print '-------------) (map-print (full-resolution (clausal-form
'(not (all x (=> (A x) (=> (B x) (A x)))))
)))
;((A skolem211))
;((B skolem211))
;((not (A skolem211)))
;found
;clause-i
;((A skolem211))
;clause-j
;((not (A skolem211)))
;resolution-set
;(())
;'done
(newline)
(define C1 '( (not (Man ?x)) (Mortal ?x) ) )
(define C2 '( (Man Socrates) ) )
(define C3 '( (not (Mortal ?x)) (Answer ?x) ) )
;; either x is not mortal, or we have got the answer
(print '-------------) (map-print (full-resolution
(list C1 C2 C3)
))
;((not (Man ?x)) (Mortal ?x))
;((Man Socrates))
;((not (Mortal ?x)) (Answer ?x))
;((Mortal Socrates))
;((Answer Socrates)) ;; there exists Socrates who is Mortal
;((not (Man ?x)) (Answer ?x))
;'done
(newline)
;; Meredith's inference rule of condensed detachment
(print '-------------)(map-print (clausal-form
'(not (=> (=> (=> (=> (=> A B)
(=> (not C) (not D)) )
C)
E)
(=> (=> E A) (=> D A))
))
))
;(A C (not D) E)
;((not B) C (not D) E)
;((not C) E)
;((not E) A)
;(D)
;((not A))
;'done
(newline)
(print '-------------)(map-print (full-resolution (clausal-form
'(not (=> (=> (=> (=> (=> A B)
(=> (not C) (not D)) )
C)
E)
(=> (=> E A) (=> D A))
))
)))
;; orginal clauses omitted
;((not E))
;((not C))
;(A C E)
;(C E)
;(C)
;found
;clause-i
;((not C))
;clause-j
;(C)
;resolution-set
;(())
;'done
(newline)
;; Is this good enough for a proof?
(map contains-complements? (clausal-form
'(=> (=> (=> (=> (=> A B)
(=> (not C) (not D)) )
C)
E)
(=> (=> E A) (=> D A))
)
))
;'done
(newline)
(find-predicate-symbols '(P (Q x y) (R x y (f z (ff x)) (g c)) (S (h d) x y)))
(find-function-symbols '(P (Q x y) (R x y (f z (ff x)) (g c)) (S (h d) x y)))
;'done
;(Q R S)
;(f ff g h)
(newline)
(clausal-form '(all x (= x x)) )
(clausal-form '(all x (all y (=> (= x y) (= y x)))) )
(clausal-form '(all x (all y (all z (=> (and (= x y) (= y z)) (= x z))))) )
;'done
;(((= ?x378 ?x378)))
;(((not (= ?x382 ?x383)) (= ?x383 ?x382)))
;(((not (= ?x389 ?x390)) (not (= ?x390 ?x391)) (= ?x389 ?x391)))
;;
;; Add equality axioms:
;; 1. x=x (Reflexive axiom)
;; 2. x=y IMPLIES y=x (Symmetric axiom)
;; 3. x=y AND y=z IMPLIES x=z (Transitive axiom)
;; 4. for each function add: x=y IMPLIES F(x)=F(y)
;; or: x=z AND y=w IMPLIES F(x y)=F(z w)
;; etc.
;; 5. for each predicate add: x=y IMPLIES ( P(x) IFF P(y) )
;; x=z AND y=w IMPLIES ( P(x y) IFF P(z w) )
;; etc.
(newline)
(define C0 '( (W (g ?x ?y ?z)) P Q (H ?x ?y ?z ?u) ) )
(define C1 '( (not (S ?x)) (T (f ?x)) ) )
(define C2 '( (not (S ?x)) (E ?x (f ?x)) ) )
(define C3 '( (not (W ?x)) (S ?x) ) )
(define C4 '( (W c) ) )
(define C5 '( (D c) ) )
(define C6 '( (not (T ?z)) (not (D ?y)) (not (E ?y ?z)) (M ?z) ) )
(define C7 '( (not (T ?z)) (not (M ?z)) ) )
(map-print (add-equality-axioms (list C1 C2 C3 C4 C5 C6 C7 C0)))
(length (list C1 C2 C3 C4 C5 C6 C7 C0) )
(length (add-equality-axioms (list C1 C2 C3 C4 C5 C6 C7 C0)))
;'done
;8
;27
(newline)
(define seq '(1 0 1 1 1 0 0 0 1 1 1 1 1 0 1 1))
(length seq)
(list->n-tuples 2 seq)
(list->n-tuples 3 seq)
(list->n-tuples 4 seq)
;'done
;16
;((1 0) (1 1) (1 0) (0 0) (1 1) (1 1) (1 0) (1 1))
;((1 0 1) (1 1 0) (0 0 1) (1 1 1) (1 0 1) (1))
;((1 0 1 1) (1 0 0 0) (1 1 1 1) (1 0 1 1))
;; test gambit complex number representation
(newline)
(define seq2 (map (lambda (x) (make-rectangular (car x) (cadr x))) (list->n-tuples 2 seq)))
seq2
;'done
(newline)
(define m (hankel seq))
(map-print m)
;(1 0 1 1 1 0 0 0)
;(0 1 1 1 0 0 0 1)
;(1 1 1 0 0 0 1 1)
;(1 1 0 0 0 1 1 1)
;(1 0 0 0 1 1 1 1)
;(0 0 0 1 1 1 1 1)
;(0 0 1 1 1 1 1 0)
;(0 1 1 1 1 1 0 1)
(RREF rational-field m)
;(7 (7 6 5 4 3 2 1 0))
(map-print m)
;(1 0 0 0 0 0 0 0)
;(0 1 0 0 0 0 0 0)
;(0 0 1 0 0 0 0 0)
;(0 0 0 1 0 0 0 0)
;(0 0 0 0 1 0 0 0)
;(0 0 0 0 0 1 0 0)
;(0 0 0 0 0 0 1 0)
;(0 0 0 0 0 0 0 1)
(define m (hankel seq)) ;(map-print m)
(define im (inverse rational-field m))
(map-print im)
;(1/2 1/2 -1/2 1/2 1/2 -1/2 0 -1/2)
;(1/2 -5/2 3/2 1/2 -5/2 3/2 -1 3/2)
;(-1/2 3/2 -1/2 -1/2 3/2 -3/2 1 -1/2)
;(1/2 1/2 -1/2 1/2 -1/2 1/2 0 -1/2)
;(1/2 -5/2 3/2 -1/2 -3/2 3/2 -1 3/2)
;(-1/2 3/2 -3/2 1/2 3/2 -3/2 1 -1/2)
;(0 -1 1 0 -1 1 0 0)
;(-1/2 3/2 -1/2 -1/2 3/2 -1/2 0 -1/2)
(map-print (inverse rational-field im))
;(1 0 1 1 1 0 0 0)
;(0 1 1 1 0 0 0 1)
;(1 1 1 0 0 0 1 1)
;(1 1 0 0 0 1 1 1)
;(1 0 0 0 1 1 1 1)
;(0 0 0 1 1 1 1 1)
;(0 0 1 1 1 1 1 0)
;(0 1 1 1 1 1 0 1)
(map-print m)
;(1 0 1 1 1 0 0 0)
;(0 1 1 1 0 0 0 1)
;(1 1 1 0 0 0 1 1)
;(1 1 0 0 0 1 1 1)
;(1 0 0 0 1 1 1 1)
;(0 0 0 1 1 1 1 1)
;(0 0 1 1 1 1 1 0)
;(0 1 1 1 1 1 0 1)
;'done
;; note: complex number seems to enjoy the same field definition as rational
(newline)
(define m (hankel seq2))
(map-print m)
(RREF rational-field m)
(map-print m)
(define m (hankel seq2)) ;(map-print m)
(define im (inverse rational-field m))
(map-print im)
(map-print (inverse rational-field im))
(map-print m)
;'done
;(1 1+1i 1 0)
;(1+1i 1 0 1+1i)
;(1 0 1+1i 1+1i)
;(0 1+1i 1+1i 1)
;(void void void void)
;(3 (3 2 1 0))
;(1 0 0 0)
;(0 1 0 0)
;(0 0 1 0)
;(0 0 0 1)
;(void void void void)
;(33/65+9/65i 6/65-22/65i 4/65+7/65i -5/13+1/13i)
;(6/65-22/65i 7/65-4/65i -17/65+19/65i 5/13-1/13i)
;(4/65+7/65i -17/65+19/65i 32/65-9/65i -1/13-5/13i)
;(-5/13+1/13i 5/13-1/13i -1/13-5/13i 3/13+2/13i)
;(void void void void)
;(1 1+1i 1 0)
;(1+1i 1 0 1+1i)
;(1 0 1+1i 1+1i)
;(0 1+1i 1+1i 1)
;(void void void void)
;(1 1+1i 1 0)
;(1+1i 1 0 1+1i)
;(1 0 1+1i 1+1i)
;(0 1+1i 1+1i 1)
;(void void void void)
;; ambiguous operation with set! in the middle of map
(newline)
(let ((G '(1 2 3 4)))
(for-each (lambda (x)
(for-each (lambda (y)
(print (list "x y:" x y))
(set! G (delete = y G))
(print (list "G: " G))
) (delete = x G))
) G)
)
;'done
;;
;; Lie algebra
;; http://www.math.sunysb.edu/~kirillov/mat552/liegroups.pdf
;;
(define (t1 lst)
(map (lambda (i)
(exact->inexact (/ (+ (list-ref lst (mod (- i 1) (length lst)) )
(list-ref lst (mod (+ i 1) (length lst)) )) 2))
) (idx-interval0 lst))
)
(nth-apply 1 t1 '(3 6 8 5 4 3 2 5 7 8 64 6 3 333))
(nth-apply 2 t1 '(3 6 8 5 4 3 2 5 7 8 64 6 3 333))
(nth-apply 3 t1 '(3 6 8 5 4 3 2 5 7 8 64 6 3 333))
(nth-apply 9999 t1 '(3 6 8 5 4 3 2 5 7 8 64 6 3 333))
;; maybe this is what appears to be the mechanism for electron charges?
;'done
(define (t2 lst)
(map (lambda (i)
(exact->inexact (/ (+ (list-ref lst (mod (- i 2) (length lst)) )
(list-ref lst (mod (- i 1) (length lst)) )
(list-ref lst (mod (+ i 1) (length lst)) )
(list-ref lst (mod (+ i 2) (length lst)) )) 4))
) (idx-interval0 lst))
)
(nth-apply 1 t2 '(3 6 8 5 4 3 2 5 7 8 64 6 3 333))
(nth-apply 2 t2 '(3 6 8 5 4 3 2 5 7 8 64 6 3 333))
(nth-apply 3 t2 '(3 6 8 5 4 3 2 5 7 8 64 6 3 333))
(nth-apply 9999 t2 '(3 6 8 5 4 3 2 5 7 8 64 6 3 333))
;'done
;; when you have an equation like some-thing=0 you can make it integral by multiplication.
(define S '( ((5 1 0 0)(5 0 1 0)(5 0 0 1)(-5 0 0 0))
((5 2 0 0)(5 0 2 0)(5 0 0 2)(-5 0 0 0))
((5 3 0 0)(5 0 3 0)(5 0 0 3)(-5 0 0 0))
))
(polys-string lex-rational-xyz S)
(poly-string lex-rational-xyz (poly-make-integer lex-rational-xyz (first S)))
(poly-string lex-rational-xyz (poly-make-integer lex-rational-xyz (second S)))
(poly-string lex-rational-xyz (poly-make-integer lex-rational-xyz (third S)))
(define p '((2 1 0 0)(4 0 1 0)(6 0 0 1)(-8 0 0 0)) )
(poly-string lex-rational-xyz (poly-make-integer lex-rational-xyz p))
(define p '((-1/2 1 0 0)(4 0 1 0)(6 0 0 1)(-8 0 0 0)) )
(poly-string lex-rational-xyz (poly-make-integer lex-rational-xyz p))
(define p '((-1/2 1 0 0)(4 0 1 0)(1 0 0 1)(-8 0 0 0)) )
(poly-string lex-rational-xyz (poly-make-integer lex-rational-xyz p))
(define p '((-1/2 1 0 0)(4 0 1 0)(1/3 0 0 1)(-8 0 0 0)) )
(poly-string lex-rational-xyz (poly-make-integer lex-rational-xyz p))
;'done
;"(x)+(2*y)+(3*z)+(-4)"
;"(x)+(-8*y)+(-12*z)+(16)"
;"(x)+(-8*y)+(-2*z)+(16)"
;"(3*x)+(-24*y)+(-2*z)+(48)"
(define x (list->stream (list 1 2 3 4)))
(stream-car x)
(stream-car (stream-cdr x))
(stream-car (stream-cdr (stream-cdr x)))
(stream-null? x)
(stream-ref x 0)
(stream-ref x 1)
;1
;2
;3
;#f
;1
;2
;'done
(define x (stream-interval 1 20))
(stream-display x)
(stream-display (stream-filter even? x))
;1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 done
;2 4 6 8 10 12 14 16 18 20 done
;'done
(map (lambda (i) (stream-ref exp-series i)) (interval 0 20))
(map (lambda (i) (stream-ref cosine-series i)) (interval 0 20))
(map (lambda (i) (stream-ref sine-series i)) (interval 0 20))
;'done
;; prove sin^2 + cos^2 = 1
(map (lambda (i)
(stream-ref (add-series (mul-series cosine-series cosine-series)
(mul-series sine-series sine-series)
)
i
)
) (interval 0 20))
;'done
(define l (list 0 0 1 -9 51 -256 1314 -6996 37483 -199377 1055853 -5591980))
(define s (list->stream l))
(map (lambda (i)
(stream-ref (euler-transform s) i)
)
(interval 0 (- (length l) 3) ) ;; accelerated list has 2 less elements
)
;'done
(amb-run (print (amb-cross-product '( (x1 x2) (y1 y2 y3) ))))
;'done
;; complex numbers:
(+ 1+2i 5+6i)
(- 1+2i 5+6i)
(* 1+2i 5+6i)
(/ 1+2i 5+6i)
(* 1+2i 5-6i)
(* 5+6i 5-6i)
(* 1+2i 1-2i)
(* 5+6i 1-2i)
(- (/ 5 17-4i) (/ 1+2i 5+6i))
;'done
;; representation of the same complex number is not unique!
;; see last example
;6+8i
;-4-4i
;-7+16i
;17/61+4/61i
;17+4i
;61
;5
;17-4i
;0
(newline)
(define x 1)
(define y 2)
(define z 3)
(list x y z)
;'done
;; (for-loop x x-max do-stuff)
(newline)
(for-loop 1 5 (lambda (x) (print x)))
;'done
;; (make-list n x)
(newline)
(make-list 5 'apple)
;'done
;; (cross-product lst)
(newline)
(cross-product '((a b c) (1 2 3 4)))
;'done
;; (count-leaves tree)
(newline)
(count-leaves '((1 2 3) (1 2)))
(length '((1 2 3) (1 2)))
;'done
;; (tree-map func tree)
(newline)
(tree-map print '((1 2 3) (4 5)))
;'done
;; (gensym . symstr)
(newline)
(gensym)
(gensym)
(gensym "some")
(gensym "some")
(gensym "some")
;'done
;; (flatten1 lst)
(newline)
(define x '(1 (2 (3)) 4) )
x
(flatten1 x)
(flatten x)
;'done
;; (list-copy ls)
(newline)
(define x '(1 2))
(define y (list-copy x))
x y
(eq? x y)
(eqv? x y)
(equal? x y)
;'done
;; retest later
(newline)
(eq? (* 2 2) (sqrt 16))
(eqv? (* 2 2) (sqrt 16))
;'done
(newline)
(define x 2)
(define y 2)
(eq? 'x 'y)
(eq? 'x 2)
(eq? x 2)
(eqv? x 2)
(equal? '(1 2 3) '(1 2 3))
;'done
;
; so the lesson here is that "eq?" is good for comparing symbols (exact same symbol)
; don't use eq? in mixed situation
; equal? is good for comparing objects
; eqv? is sorta fuzzy
;
;; (nth-cdr n lst)
(newline)
(nth-cdr -1 '(1 2 3))
(nth-cdr 0 '(1 2 3))
(nth-cdr 1 '(1 2 3))
;'done
;; (take n lst)
(newline)
(take -1 '(1 2 3))
(take 0 '(1 2 3))
(take 1 '(1 2 3))
(take 2 '(1 2 3))
;'done
;; (iota count begin inc)
(newline)
(iota -1 1 1)
(iota 0 1 1)
(iota 1 1 1)
(iota 2 1 1)
;'done
;; (take-right n lst)
(newline)
;(take-right -1 '(1 2 3))
(take-right 0 '(1 2 3))
(take-right 1 '(1 2 3))
(take-right 2 '(1 2 3))
;'done
;; (tree-sub x y tree) ;; subs x for y
(newline)
(define x '(apple orange (apple orange (apple orange 1) 2) 3))
x
(tree-sub 'apple 'orange x)
x
;'done
;; (safe-tree-sub lst tree)
(newline)
(define x '(apple orange (apple orange (apple orange 2 3) 3 4) 2 3 4))
x
(safe-tree-sub '((2 banana) (3 pear) (4 peach)) x)
x
(safe-tree-sub '((2 banana) (banana pear) (pear peach)) x)
x
;'done
(newline)
(eq? 'apple 'apple)
(eq? 'apple ''apple)
(eq? ''apple 'apple)
(eqv? 'apple 'apple)
(eqv? 'apple ''apple)
(eqv? ''apple 'apple)
(equal? 'apple 'apple)
(equal? 'apple ''apple)
(equal? ''apple 'apple)
;'done
(newline)
((lambda x x) 1)
;'done
;; (delete = x ls)
;; only delete elements from first level
(newline)
(define x '(apple orange (apple orange (apple orange 2 3) 3 4) 2 3 4))
x
(delete eq? 'apple x)
x
(delete eq? 2 x)
x
;'done
;; (contains? = element lst)
;; only search elements from first level
(newline)
(define x '(apple (apple (apple orange 3) 2) 1)) x
(contains? eq? 1 x)
(contains? eq? 2 x)
(contains? eq? 'apple x)
(contains? eq? 'orange x)
;'done
;; (list->set = lst)
(newline)
(list->set = '(1 2 3 3 3))
(list->set eq? '(a a b b c c))
;'done
;; (search-list i = element lst)
;; return index of element from list, i is the index for the first element
(newline)
(search-list -1 = 1 (interval 1 10))
(search-list 0 = 1 (interval 1 10))
(search-list 1 = 1 (interval 1 10))
(search-list -1 = 5 (interval -1 10))
(search-list 0 = 5 (interval 0 10))
(search-list 1 = 5 (interval 1 10))
;'done
;; (set-minus = set1 set2)
(newline)
(set-minus = '(1 2 3 4) '(1 2))
;'done
;; (set-cmp? = s1 s2)
(newline)
(set-cmp? = '(1 2 3 4) '(4 3 2 1 1 1 2 3 4))
;'done
;; (idx-interval0 lst)
;; return a list of indices starting from 0
(newline)
(idx-interval0 '())
(idx-interval0 '(a))
(idx-interval0 '(a b))
(idx-interval0 '(a b c))
(idx-interval0 '(a b c d))
;'done
;; (list-ref lst pos)
;; return nth element from list (n starts at 0)
(newline)
;(list-ref '(1 2 3 4 5) -1)
(list-ref '(1 2 3 4 5) 0)
(list-ref '(1 2 3 4 5) 1)
;'done
;; (swap i j lst)
; swap ith and jth elements (i and j starts at 0)
(newline)
(define x '(0 1 2 3 4 5))
x
(swap 0 5 x)
x
;'done
;; (nth-apply n func x0)
;; iterate n times
(newline)
(nth-apply -1 (lambda (x) (+ x 1)) 0)
(nth-apply 0 (lambda (x) (+ x 1)) 0)
(nth-apply 1 (lambda (x) (+ x 1)) 0)
(nth-apply 2 (lambda (x) (+ x 1)) 0)
(nth-apply 3 (lambda (x) (+ x 1)) 0)
;'done
;; (rotate-right lst)
(newline)
(define x '(0 1 2 3 4 5))
x
(rotate-right x)
x
;'done
;; (rotate-left ls)
(newline)
(define x '(0 1 2 3 4 5))
x
(rotate-left x)
x
;'done
;; (transpose matrix)
(newline)
(define x '((1 2)(3 4))) (map-print x)
(map-print (transpose x)) (map-print x)
;'done
(newline)
(for-each (lambda (x) (print (list x 'apple))) '(1 2 3))
;'done
;; (tree-cmp? = t1 t2)
;; (tree-eq? t1 t2) use "eq?" as comparator
(newline)
(define x '((1 2)(3 4)))
(define y '((1 2)(3 4)))
(tree-cmp? = x y)
(tree-eq? x y)
(define x '((a b)(c d)))
(define y '((a b)(c d)))
(tree-cmp? eq? x y)
(tree-eq? x y)
(newline)
(define a 1)
(eq? a 1)
(define x '(a (a b)(c d)))
(define y '(1 (a b)(c d)))
(tree-cmp? eq? x y)
(tree-cmp? eqv? x y)
(tree-cmp? equal? x y)
(tree-eq? x y)
(newline)
(define a 1)
(eq? a 1)
(define x (list a 2 3 '(4 b c)))
(define y (list 1 2 3 '(4 b c)))
(tree-cmp? eq? x y)
(tree-cmp? eqv? x y)
(tree-cmp? equal? x y)
(tree-eq? x y)
;'done
;; (tree-contains? = x tree)
(newline)
(define x '((1 2)(3 4)))
(tree-contains? = 1 x)
(tree-contains? = 5 x)
;'done
(newline)
(define x (cons 1 2))
(car x)
(cdr x)
(define x (list 1 2))
(car x)
(cdr x)
;'done
;; (gen-indices-set n)
;; generate a list of indices pairs that are good for bubble sort
;; index starts at 0
;; so for 4 elements, you specify 4
(newline)
(gen-indices-set -1)
(gen-indices-set 0)
(gen-indices-set 1)
(gen-indices-set 2)
(gen-indices-set 3)
(gen-indices-set 4) ; ((0 . 1) (0 . 2) (0 . 3) (1 . 2) (1 . 3) (2 . 3))
;'done
;; (insertion-sort < ls)
(newline)
(define x '(3 1 1 2 2))
x
(insertion-sort < x)
x
;'done
;; (collect-leaves pred tree)
;; collect elements from tree
(newline)
(define x '( 1 2 ( 11 12 ( 21 22 23 ) 13 14 15 16 ) 3 4 5 6 7 8 9 ) )
(collect-leaves (lambda (level pos left right) #t) x) ;; collect all
(collect-leaves (lambda (level pos left right) (= 0 level)) x)
(collect-leaves (lambda (level pos left right) (= 1 level)) x)
(collect-leaves (lambda (level pos left right) (= 2 level)) x)
(collect-leaves (lambda (level pos left right) (= 3 level)) x)
;'done
;(1 2 11 12 21 22 23 13 14 15 16 3 4 5 6 7 8 9)
;()
;(1 2 3 4 5 6 7 8 9)
;(11 12 13 14 15 16)
;(21 22 23)
;; important tricks
(newline)
(map + '(1 2 3) '(4 5 6)) ;(5 7 9)
(map * '(1 2 3) '(4 5 6)) ;(4 10 18)
;'done
;; optional arguments
(newline)
(define (func . x) (print x) 'void)
(func)(func 1)
(define (func . x) (if (not (null? x)) (print "have something") (print "nothing")))
(func)(func 1)
;'done
;; strange map
;; don't work
;(newline)
;(map (lambda (x . y) (print (list x y))) '(1 2 3) 3)
;'done
;; (nth-apply n func x0)
(newline)
(define (chaos prev) (- (/ 19 10) (* prev prev)))
(nth-apply 6 chaos (/ 9 10))
(nth-apply 12 chaos (/ 9 10))
(newline)
(define n 100)
(define y (map (lambda (i) (nth-apply i chaos 0.9)) (interval 1 n)))
(define x (interval 1 n))
(define z (transpose (list x y)))
;(map-print z)
(let ( (port (my-open-output-file (string-append "/tmp/chaos-" interpreter ".txt") )) )
(map-print z port)
(close-output-port port)
)
;'done
;; x0:=9/10; chaos:=proc(x) 19/10 - x^2 end proc;
;; for i from 1 to 6 do if (i=1) then x:=chaos(x0) else x:=chaos(x) fi;od;x;
;; for i from 1 to 12 do if (i=1) then x:=chaos(x0) else x:=chaos(x) fi;od;x;
; plot "/tmp/chaos-petite.txt","/tmp/chaos-gambit.txt","/tmp/chaos-mzscheme.txt"
; logic calculator
(newline)
(define (logic-calc func lst) (map (lambda (x) (apply func x)) lst))
(logic-calc (lambda (p q) (iff p q)) '((#t #t)(#t #f)(#f #t)(#f #f)))
;'done
(newline)
(getenv "TERM")
"1234"
#\a
(list 'a1 "a1" "1.2" "1.2e5" "1" #\a "123" "abc" (list "2" (list "3")))
;'done
(newline)
(square? 25)
(square? 24)
(sqrt 25)
(sqrt 24)
;'done
;#t
;#f
;5
;4.898979485566356
;; (mean lst)
(newline)
(mean '(1 2 3 4 5))
(mean '((1 2 3) (1 2 3 4) (1 2 3 4 5)))
;'done
; variance = (standard deviation)^2 = sum of squared difference from mean / number of samples
(newline)
(variance '((1 2 3) (1 2 3 4) (1 2 3 4 5)))
;'done
(newline)
(standard-deviation '((1 2 3) (1 2 3 4) (1 2 3 4 5)))
;'done
;(0.816496580927726 1.118033988749895 1.4142135623730951)
(newline)
(bag-of (gen-prime 100))
(length (bag-of (gen-prime 100)))
(amb-run (print (number-between 1 3)))
(amb-run (print (amb-list '(4 5 6))))
;'done
(newline)
(amb-run
(let* ((x (amb-list '(3 4 5)))
(y (number-between x 6))
(z (list x y))
)
(print z)
)
)
;'done
(newline)
(filter prime? (interval -9 9))
;'done
;; (foldr1 binop l)
;; (foldl1 binop l)
(newline)
(foldr1 + '(1 2 3 4 5))
(foldr1 (lambda (x y) (/ (+ x y) 2)) '(1 2 3 4 5))
(foldr1 (lambda (x y) (/ (+ x y) 2)) (reverse '(1 2 3 4 5)))
(foldl1 (lambda (x y) (/ (+ x y) 2)) '(1 2 3 4 5))
(foldl1 (lambda (x y) (/ (+ x y) 2)) (reverse '(1 2 3 4 5)))
(foldr1 (lambda (x y) (print (list x y))) '(1 2 3 4 5))
(foldl1 (lambda (x y) (print (list x y))) '(1 2 3 4 5))
;'done
;; takes 0 1 -> #f #t
(newline)
(binary->boolean '(0 1 0 1))
;'done
;; (random n) return integer from 0-(n-1)
;; (Random n) return integer from 1 n
(newline)
(insertion-sort < (list->set = (map random (make-list 1000 3))))
(insertion-sort < (list->set = (map Random (make-list 1000 3))))
(insertion-sort > (list->set = (map random (make-list 1000 3))))
(insertion-sort > (list->set = (map Random (make-list 1000 3))))
(mean (map random (make-list 10 2)))
(mean (map random (make-list 100 2)))
(mean (map random (make-list 1000 2)))
(mean (map random (make-list 2000 2)))
(mean (map random (make-list 4000 2)))
(mean (map random (make-list 8000 2)))
;'done
;; identity formula tests
(newline)
(map (lambda (i)
(set! x (map random (make-list 100 10))) x
(set! y (map random (make-list 100 10))) y ; var(X+Y)=var(X)+var(Y)+2Cov(X,Y)
(- (variance (map + x y)) (variance x) (variance y) (* 2 (covariance x y)))
)
(interval 1 10)) ;; should only see zeroes
(map (lambda (i)
(set! x (map random (make-list 100 10))) x
(set! y (map random (make-list 100 10))) y ; Cov(X,Y)=E(XY)-E(X)E(Y)
(- (mean (map * x y)) (* (mean x) (mean y)) (covariance x y))
)
(interval 1 10)) ;; should only see zeroes
(map (lambda (i)
(set! x (map random (make-list 100 10))) x ; Cov(X,X)=var(X)
(- (covariance x x) (variance x))
)
(interval 1 10)) ;; should only see zeroes
(map (lambda (i)
(set! x (map random (make-list 100 10))) x
(set! y (map random (make-list 100 10))) y
(set! z (map random (make-list 100 10))) z
(let* ((a (Random 10)) (b (Random 10))
(ax (map (lambda (x) (* a x)) x))
(by (map (lambda (x) (* b x)) y))
) ; Cov(aX+bY,Z)=a Cov(X,Z)+b Cov(Y,Z)
(- (covariance (map + ax by) z) (* a (covariance x z)) (* b (covariance y z)))
)
)
(interval 1 10)) ;; should only see zeroes
;'done
;; identity formula tests
(newline)
(define z
(map (lambda (i)
(set! x (map random (make-list 10 10))) x
(set! y (map random (make-list 10 10))) y ; cor(X,Y)=cov(X,Y)/[sd(X)*sd(Y)]
(- (correlation x y) (/ (covariance x y) (* (standard-deviation x) (standard-deviation y))))
)
(interval 1 100))) ;; should only see very tiny numbers
(let ( (port (my-open-output-file (string-append "/tmp/chaos-" interpreter ".txt"))) )
(map-print z port)
(close-output-port port)
)
;'done
; plot "/tmp/chaos-petite.txt","/tmp/chaos-gambit.txt","/tmp/chaos-mzscheme.txt"
;
; find "exact" formula for correlation (no standard-deviation [i.e. sqrt] if possible)
;
; some maple notes
; # map(proc(x) if x>1 then print(BUG) fi end proc, lst);
; # zip(proc(x,y) x^y end proc,[1,2,3],[2,2,2]);
; interface(prettyprint=0):interface(screenwidth=infinity):interface(warnlevel=0):
; with(ListTools):with(Groebner):with(linalg):
; numtopoly:=proc(n,b) local c,e,i,p: p:=0:
; c:=convert(n,base,b): e:=[seq(x^i,i=0..nops(c)-1)]:
; for i from 1 to nops(c) do p:=p+c[i]*e[i] od: p end proc:
; getcoeffs:=proc(p) [seq(coeff(p,x,i),i=0..degree(p))] end proc:
; poly_factorset:=proc(a,K) local x; if a=0 then {} else
; {seq(x[1],x in factors(args)[2])} fi end proc:
; poly_factorlists:=proc(a,K) local x; if a=0 then {} else
; [[seq(x[1],x in factors(args)[2])],[seq(x[2],x in factors(args)[2])]] fi end proc:
; sumlist:=proc(l) local s,i: s:=0: for i from 1 to nops(l) do s:=s+l[i] od: s end proc:
; sum2lists:=proc(lst1,lst2) zip(`+`,lst1,lst2) end proc:
;
; mean:=proc(l) m:=0: for i from 1 to nops(l) do m:=m+l[i] od: m:=m/nops(l): m end proc:
; mean([1,2,3]);mean([1,2,3,4]);mean([l1,l2,l3,l4]);
;
; variance = (standard deviation)^2 = sum of (squared "difference from mean") / number-of-samples
; var:=proc(l) v:=0:for i from 1 to nops(l) do v:=v+(l[i]-mean(l))^2 od: v:=v/nops(l): v end proc:
; var([1,2,3]);var([1,2,3,4]);var([1,2,3,4,5]);
;
; let mean(X)=u mean(Y)=v Cov(X,Y)=mean((X-u)(Y-v))
; identity formula : var(X+Y)=var(X)+var(Y)+2Cov(X,Y)
; Cov(X,Y)=E(XY)-E(X)E(Y)
; Cov(X,X)=var(X)
; Cov(aX+bY,Z)=a Cov(X,Z)+b Cov(Y,Z)
; cor(X,Y)=cov(X,Y)/[sd(X)*sd(Y)]
; cor(X,Y)=cov( [X-E(X)]/sd(X) , [Y-E(Y)]/sd(Y) )
;
; cov:=proc(l1,l2) l:=0:for i from 1 to nops(l1) do l[i]:=(l1[i]-mean(l1))*(l2[i]-mean(l2)) od:
; mean(convert(l,list)) end proc;
; cov([1,1,2,3],[1,4,5,6]);cov([1,1,2,3,4],[1,4,5,6,7]);cov([1,1,2,3,4,5],[1,4,5,6,7,8]);
;
; cor:=proc(l1,l2) m1:=0:m2:=0:for i from 1 to nops(l1) do m1[i]:=(l1[i]-mean(l1))/sqrt(var(l1)):
; m2[i]:=(l2[i]-mean(l2))/sqrt(var(l2)): od: cov(convert(m1,list),convert(m2,list)) end proc;
; cor([1,1,2,3],[1,4,5,6]);cor([1,1,2,3,4],[1,4,5,6,7]);cor([1,1,2,3,4,5],[1,4,5,6,7,8]);
; evalf(cor([1,1,2,3],[1,4,5,6]));evalf(cor([1,1,2,3,4],[1,4,5,6,7]));
; evalf(cor([1,1,2,3,4,5],[1,4,5,6,7,8]));
;
; cor2:=proc(l1,l2) cor(l1,l2)^2 end proc;
; cor2:=proc(l1,l2) cov(l1,l2)^2/(var(l1)*var(l2)) end proc;
; cor2([1,1,2,3],[1,4,5,6]);cor2([1,1,2,3,4],[1,4,5,6,7]);cor2([1,1,2,3,4,5],[1,4,5,6,7,8]);
; cor2([1,1,2,3,1],[1,4,5,6,1]);cor2([1,1,2,3,4,1,1],[1,4,5,6,7,1,1]);
; cor2([1,1,2,3,4,5,1,1,1],[1,4,5,6,7,8,1,1,1]);
;
; mean:=proc(l) m:=0: for i from 1 to nops(l) do m:=m+l[i] od: m:=m/nops(l): m end proc;
; var:=proc(l) v:=0:for i from 1 to nops(l) do v:=v+(l[i]-mean(l))^2 od: v:=v/nops(l): v end proc;
; cov:=proc(l1,l2) l:=0:for i from 1 to nops(l1) do l[i]:=(l1[i]-mean(l1))*(l2[i]-mean(l2)) od:
; mean(convert(l,list)) end proc;
; cor:=proc(l1,l2) m1:=0:m2:=0:for i from 1 to nops(l1) do m1[i]:=(l1[i]-mean(l1))/sqrt(var(l1)):
; m2[i]:=(l2[i]-mean(l2))/sqrt(var(l2)): od: cov(convert(m1,list),convert(m2,list)) end proc;
; cor2:=proc(l1,l2) cov(l1,l2)^2/(var(l1)*var(l2)) end proc;
; x:=[x1,x2,x3,x4,x5]:y:=[y1,y2,y3,y4,y5]:normal(cor(x,y)^2-cor2(x,y));
;
;
; test variance
(newline)
(variance '(1 2 3))
(variance '(1 2 3 4))
(variance '(1 2 3 4 5))
;'done
;2/3
;5/4
;2
(newline)
(covariance '(1 1 2 3) '(1 4 5 6))
(covariance '(1 1 2 3 4) '(1 4 5 6 7))
(covariance '(1 1 2 3 4 5) '(1 4 5 6 7 8))
;'done
;5/4
;52/25
;55/18
(newline)
(correlation '(1 1 2 3) '(1 4 5 6))
(correlation '(1 1 2 3 4) '(1 4 5 6 7))
;'done
;0.8058229640253802
;0.8661855860486003
;; correlation squared
;; (correlation2 lst1 lst2)
(newline)
(correlation2 '(1 1 2 3) '(1 4 5 6))
(correlation2 '(1 1 2 3 4) '(1 4 5 6 7))
(correlation2 '(1 1 2 3 4 5) '(1 4 5 6 7 8))
(correlation2 '(1 1 2 3 1) '(1 4 5 6 1))
(correlation2 '(1 1 2 3 4 1 1) '(1 4 5 6 7 1 1))
(correlation2 '(1 1 2 3 4 5 1 1 1) '(1 4 5 6 7 8 1 1 1))
;'done
;50/77
;676/901
;121/148
;289/424
;3364/4309
;841/1003
;; (unfoldr1 binop lst)
;; (unfoldl1 binop lst)
(newline)
(unfoldr1 '+ '(1 2 3 4 5))
(unfoldl1 '+ '(1 2 3 4 5))
;'done
;; (while test body1 . bodyrest)
(newline)
(define x 5)
(while (> x 0)
(print x)
(set! x (- x 1))
)
(print x)
;'done
;; (assign x y)
;; assign a list x's first element with value y
;; return y
(newline)
(define x (list 5))
x
(assign x 6)
x
;'done
;; (0 1 1 2 3 5 8 13 21 34 55 89 144 233 377 610 987 1597 2584 4181 6765)
(newline)
(map memo-fib (interval 0 20))
;'done
;; lst must have at least one element already
;; (cons! x lst)
(newline)
(define x '(1 2 3))
x
(cons! 'apple x)
x
;'done
;(1 2 3)
;(apple 1 2 3)
;(apple 1 2 3)
;; lst must have at least one element already
;; (append! lst1 lst2)
;; lst1 is the list that's changed
(newline)
(define x '(1 2 3))
(define y '(apple orange))
x y
(append! x y)
x y
;'done
;(1 2 3)
;(apple orange)
;(1 2 3 apple orange)
;(1 2 3 apple orange)
;(apple orange)
;; (convert-to-base n b)
(newline)
(convert-to-base 15 2)
;'done
;; (convert-from-base n b)
(newline)
(convert-from-base '(1 1 1 1) 2)
;'done
;; append zeroes to a list making it length n
;; (list->row n lst)
(newline)
(list->row 10 '(1 2 3 4 5))
;'done
;; map a list to a function then sort
;; return list of pairs indicating original locations (element . location)
;; (map-sort func < lst)
(newline)
(map-sort identity < '(3 2 1))
;'done
; ((1 . 2) (2 . 1) (3 . 0))
;; (rotate-left-n n lst)
(newline)
(rotate-left-n 1 '(1 2 3))
;'done
;; (rotate-right-n n lst)
(newline)
(rotate-right-n 1 '(1 2 3))
;'done
;; (all-zero? zero? lst)
(newline)
(all-zero? zero? '(0 0 0))
(all-zero? zero? '(0 0 1))
;'done
;; (all-zero-matrix? zero? lst)
(newline)
(all-zero-matrix? zero? '((0 0)(0 0)))
(all-zero-matrix? zero? '((0 0)(1 0)))
;'done
;; return identity matrix
;; (identity-matrix n)
(newline)
(map-print (identity-matrix 5))
;'done
;; (factorial n)
;; test memorized recursion
(newline)
(factorial 55)
;'done
;12696403353658275925965100847566516959580321051449436762275840000000000000
;; (matrix-ref matrix row col)
;; (matrix-set! matrix row col value)
;; (matrix-swap-columns! matrix i j)
;; (transpose! matrix)
;; only use it for square matrix, else use (transpose matrix)
;; (matrix-row-op! matrix i func)
(newline)
(define x '((1 2)(3 4)))
(map-print x)
(map-print (matrix-row-op! x 0 (lambda (x) 'apple)))
(map-print x)
;'done
;; (matrix-column-op! matrix j func)
(newline)
(define x '((1 2)(3 4)))
(map-print x)
(map-print (matrix-column-op! x 1 (lambda (x) 'apple)))
(map-print x)
;'done
;; (matrix-get-column matrix j)
;; (matrix-set-column! matrix j lst)
;; (matrix-add field m1 m2)
;; (matrix-sub field m1 m2)
;; (inner-product field lst1 lst2)
(newline)
(inner-product rational-field '(1 2 3) '(3 2 1))
;'done
;; (to-maple-list ls)
;; (to-maple-set ls)
;; (to-maple-matrix m)
;; (matrix-mul field m1 m2)
;; (matrix-get-diagonal matrix) ;; only works for square matrix
(newline)
(matrix-get-diagonal '((1 2)(2 1)))
;'done
;; (matrix-set-diagonal! matrix lst) only works for square matrix
;; (matrix-apply func matrix)
;; (matrix-apply! func matrix)
;; (matrix-zero-out-lower! field matrix)
;; (matrix-zero-out-upper! field matrix)
;; (matrix-swap-elements! matrix i j k l)
;; (matrix-permutate! matrix plist)
;; (matrix-permutate matrix plist)
;; (matrix-cat m1 m2)
(newline)
(map-print (matrix-cat '((1 2)(2 1)) '((3 4)(4 3)) ))
;'done
;; (row-reduce field matrix)
;; (rref field matrix) ;; row-reduced echelon form, return rank and pivots (ignore pivots)
;; (rank field matrix) ;; matrix rank
;; (inverse field mat) ;; invert square matrix
;; NOTE: rref rank inverse are unique for all matrices
(newline)
(define m '((0 3 -6 6 4 -5)(3 -7 8 -5 8 9)(3 -9 12 -9 6 15)))
(map-print m)
(RREF rational-field m)
(map-print m)
(define n '((0 3 -6 6 4 -5)(3 -7 8 -5 8 9)(3 -9 12 -9 6 15)))
(map-print (rref n))
(tree-eq? m (rref n))
;'done
;(2 (4 1 0))
;(1 0 -2 3 0 -24)
;(0 1 -2 2 0 -7)
;(0 0 0 0 1 4)
;;
;; The number of nonzero rows in the reduced row echelon form of a matrix A
;; is called the rank
;; Theorem. Consider the m*n linear system Ax=b where M=<A|b> is the augmented matrix.
;; 1. If rank(A)=rank(M)=n then unique solution
;; 2. If rank(A)=rank(M)<n then infinite number of solution
;; 3. If rank(A)<rank(M) then no solution
;;
;; determinant of triangular matrix is the product of the diagonal
;;
;; the inverse of a permutation matrix is simply its transpose
;;
;; use rref to find inverse (I A^-1)=rref(AI)
;;
;; If the determinant of a matrix is 0, the matrix is said to be singular
;;
;; not invertible <=> not full rank <=> singular <=> determinant=0
;; invertible <=> determinant<>0
;;
;; http://www.math.uu.nl/people/bisselin/PSC/psc2_1.pdf
;;
;; all index starting with 1
;; lu-decomposition
;; input A
;; output (determinant p L U)
;; pA=LU
;; this function can fail, check if p is null first
;; only magnitude of determinant is correct (the sign is not necessarily correct)
;; Note: LU decomposition is not unique: if A = LU, then A = L DD^(-1) U = (LD) (D^(-1)U)
;; Note: full-rank seems to give the same LU as Maple does
;;
;; full-rank <=> determinant is not 0
;; det(AB)=det(A)det(B)
;; det(rA)=r^n det(A)
;; det(A)^-1 = det(A^-1) iff A is full-rank
;;
;; (ludecomp field matrix)
;; (inc x) increment whole list by 1 or increment number by 1
;; (dec x) decrement whole list by 1 or decrement number by 1
;;
(newline)
(inc 1)
(inc '(1 2 3))
(dec 1)
(dec '(1 2 3))
;'done
;; x^d mod n
;; (powermod x d n)
;; (powermod-table n)
(newline)
(map-print (powermod-table 5))
(map-print (powermod-table 7))
;'done
;; (n>=1) n=x^y for some y>=2
;; (perfect-power-of? n x)
(newline)
(perfect-power-of? 25 5)
(perfect-power-of? 25 2)
;'done
;; (log2 n)
(newline)
(log2 -4)
(log2 -3)
(log2 0)
(log2 4)
(log2 5)
(log2 6)
(log2 7)
(log2 8)
;0
;0
;0
;2
;2
;2
;2
;3
;'done
;; (factor n)
(newline)
(map-print (map factor (interval -6 6)))
;(-1 2 3 1)
;(-1 5 1)
;(-1 2 2 1)
;(-1 3 1)
;(-1 2 1)
;(-1 1)
;(0)
;(1)
;(2 1)
;(3 1)
;(2 2 1)
;(5 1)
;(2 3 1)
(factor 9999)
;(3 3 11 101 1)
;'done
; so one way of interpreting chaos is simply accumulation of uncancelled numerators?
; apply "cancelled numerators" idea to form a 2D circle?
;
; maybe chaos (simply the process of applying difference equations [approximation])
; can be used to characterize phase transitions?
;
; maybe the cause is simply dissipation?
;
; maybe the study should have been to recover some physical law from
; discreet interval (spacial or temporal) data?
;
; maybe chaos can be explained as discreet (or random interval) sampling problem?
; simply because not every entity is strictly following the calculus rule of
; a limiting process? or simply every entity is sampling something out of sync?
; that seems to make sense simply because strict calculus rule is not followed,
; simply because the limiting process is only an argument.
;
; so the study of choas is actually reverse-engineering some underlying laws or rules.
;
; NOTE: N-dimensional time series can always be plotted in 2D, using multiple plots.
; OK actually, it only works best with time evolved curves. (t->x,y,z) (t->x,t->y,t->z)
;
; is it always possible to solve for the field equation from curve equation (test particle)?
;
; simple models are better suited to describe experiments then deep theories.
;
; to solve the 3D curve trace problem simply use blender? three walls, with some lightings.
; simply feed coordinates.
;
; phase space (synonymously state space) is simply a point plot fishing for relationship
; between variables. each point represents values measured at the same time.
; you will need (n choose 2) plots.
;
; standard phase space: for example, baby's height vs weight at different times.
;
; pseudo (lagged) phase space: (because it's actually depicting the same variable.)
; A one-dimensional map : the input or older value goes on the horizontal axis,
; and the output value goes on the vertical axis. (x0 has no point)
;
; ordinate (output, x(t+1), next x, x)
; ^
; |
; +---> abscissa (input, x(t), x, previous x)
;
; good research questions:
; 1. does elementry functions have iterative versions?
; 2. stable interval and accuracy study.
; 3. equivalent to "moving (d/dt)^n" out?
; 4. related to question 1 and 3, does infinite series has iterative versions?
; stable interval and accuracy?
;
; stupid argument?
; nature only allows one move at a time, either turning or move forward one step.
; (further restrict reaction time interval too)
; so certain phenomena like state transition happens (solid <-> liquid) because of it.
;
; interface(prettyprint=0):
; for example: sin(x) = x - x^3/3! + x^5/5! - ...
; let interval be dt sin(x+dt) = (x+dt) - (x+dt)^3/3! + (x+dt)^5/5! - ...
; = sin(x) + dt - (3*x^2*dt+3*x*dt^2+dt^3)/3! +
; + (5*x^4*dt+10*x^3*dt^2+10*x^2*dt^3+5*x*dt^4+dt^5)/5! ...
; = sin(x) + sin(dt) - ( x^2*dt+ x*dt^2 )/2! +
; + ( x^4*dt+ 2*x^3*dt^2+ 2*x^2*dt^3+ x*dt^4)/4! ...
; = sin(x) + sin(dt) - x*dt ( x + dt )/2! +
; + x*dt ( x^3 + 2*x^2*dt + 2*x*dt^2+ dt^3 )/4! ...
; sin( t + dt ) = sin(t)cos(dt) + cos(t)sin(dt)
; cos( t + dt ) = cos(t)cos(dt) - sin(t)sin(dt)
; if dt is fixed for the entire calculation, and both sin( t + dt ) and cos( t + dt ) are needed
; then the iterative version seems stable, simply sin(dt) and cos(dt) to some arbitrary accuracy
;
; lagged data: this is like Hankel matrix
;
; Embedding dimension : The embedding dimension is the total number of separate time series
; (including the original series, plus the shorter series obtained by lagging that
; series) included in any one analysis.
;
; this stuff is great for analyzing recursive trends, or for Hamiltonian stuff.
;
; In physics, a parameter is a controllable quantity that physicists keep constant
; for one or more experiments.
; In math, a parameter is an arbitrary constant in an equation.
; In statistics, a parameter is a fixed numerical characteristic of a population.
; The key is that they don't change for a particular setup. Unlike variables.
;
; angle between two vectors OA,OB
; |AB|^2 = |OA|^2 + |OB|^2 - 2 |OA| |OB| cos(theta)
; cos(theta) = x1x2+y1y2 / sqrt(x1x1+y1y1)sqrt(x2x2+y2y2)
; cos(theta) = x1x2+y1y2+z1z2 / sqrt(x1x1+y1y1+z1z1)sqrt(x2x2+y2y2+z2z2)
; cos(theta) = OA.OA/|OA||OB|
; mean = sum of samples / number of samples
; variance = (standard deviation)^2 = sum of squared difference from mean / number of samples
; relative frequence = number of occurrences of an outcome / number of trials
; The limiting relative frequency as the number of flips goes to infinity is called a probability.
; The events measured in any probability experiment must be mutually exclusive. (head or tail)
; A list of all classes and their respective probabilities is a probability distribution.
; As class width becomes smaller and sample size larger, a histogram for a continuous variable
; gradually blends into a continuous distribution called "probability density function."
; NOTE: for continuous variable, we have sample size and class width approaching infinity and 0.
; NOTE: The same data can have very different looking histograms, compare different strategies.
; Probabilities Involving Two or More Variables: for example: height and weight
; Joint probability: "Joint" in statistics means "involving two or more variables."
; NOTE: there are lots of subtleties here: for single variable like one die:
; you can have situation where each throw depends on the throw before (throw higher each time)
; For more than one variable: for two die, you can have one die influencing the other.
; "mutually exclusive" don't mean much except for purpose of recording an outcome. (loaded die)
; The common case in chaos theory involves a joint probability distribution based on two or more
; lagged values of a single variable. Joint probability distributions based on lagged values
; are very popular in chaos theory.
; For example: for one die, the study of T->T, H->H, T->H, H->T
; NOTE: for continuous variable, you will need to define some class width to divide the outcomes.
; NOTE: so you can have covariance between lagged data and different variables.
; A marginal probability is the joint probability of getting a specified value of one
; variable, irrespective of the associated value of another variable.
; Conditional probability is the probability of getting a certain outcome,
; given a specified restriction or condition.
;
; The two alternatives regarding snow in Miami show an inverse relation between probability
; and gain in information: high probability of occurrence (no snow on 4 July) implies
; a small gain in information, and vice versa.
;
; Relating information to number of classes:
; information (entropy) keeps increasing as number of classes increases.
; Combining two systems: Nxy (number of classes of combined system) = Nx * Ny
; We want Information (entropy) to be additive. Nx * Ny ~~ base^Ix * base^Iy ~~ base^(Ix+Iy)
; I = log N (N is the number of classes)
; Weighted Information:
; I = P1 log (1/P1) + ... = - P1 log P1 - ... = - sum Pi log Pi (Pi probability of each class)
;
; Autocorrelation
; A time series sometimes repeats patterns or has other properties whereby earlier values
; have some relation to later values. Autocorrelation (sometimes called serial correlation)
; is a statistic that measures the degree of this affiliation.
; Methodically evaluating the computed statistic for successively larger lags reveals
; any dependence or correspondence among segments of the time series.)
;
; Autocorrelation in a time series can cause problems in certain kinds of analyses.
; For example, many statistical measures are designed for unrelated or independent data
; (as opposed to correlated data).
; Secondly, autocorrelation might influence our choice of prediction methods.
;
; In chaos tests, autocorrelated data carry at least two additional problems.
; The first deals with a lag-space graph. (One way to resolve such a problem is to limit
; the plot to measurements that are spaced far enough apart in time to be uncorrelated.
; The second problem is that autocorrelated data introduce several complications in
; determining Lyapunov exponents and the correlation dimension.
;
; Because of those potential problems, a routine early step in analyzing any time series
; is to find out whether the data are autocorrelated. If they are, it's often a good idea
; to transform them into a related set of numbers that aren't autocorrelated, before going
; ahead with the analysis.
;
; covariance: http://en.wikipedia.org/wiki/Covariance
; let mean(X)=u mean(Y)=v Cov(X,Y)=mean((X-u)(Y-v))
; identity formula : var(X+Y)=var(X)+var(Y)+2Cov(X,Y)
; Cov(X,Y)=E(XY)-E(X)E(Y)
; Cov(X,X)=var(X)
; Cov(aX+bY,Z)=a Cov(X,Z)+b Cov(Y,Z)
; cor(X,Y)=cov(X,Y)/[sd(X)*sd(Y)]
; cor(X,Y)=cov( [X-E(X)]/sd(X) , [Y-E(Y)]/sd(Y) )
;
; The formula for autocorrelation has two ingredients: autocovariance and variance.
; autocorrelation(s1,s2)=autocovariance(s1,s2)/variance (this is simply lazy)
; Just take properly the standard-deviations for the time series and its lagged series
; autocorrelation(s1,s2)=autocovariance(s1,s2)/autovariance(s1,s2)
;
;
; Correlation is a statistic that measures how well the paired variables plot on a straight line.
; Correlation has the range (-1..1)
; 1 means identical series
; -1 means negated series
(map-print
(map (lambda (i)
(set! x (map random (make-list 1000 10)))
(set! y (map negate x))
(list (round (correlation x x)) (round (correlation x y)))
)
(interval 1 10)))
;'done
;
; Write cheques for SFU, Maplesoft, Douglas College, and some books' authors.
;
; Riemann hypothesis <=> Hamiltonian <=> Navier-Stokes equations <=>
; a(t)=b(t) c(t)=d(t) a/c=b/d a/d=b/c
;
;; flatten one level
(flatten1 '((1)(2)(3)))
;(1 2 3)
(flatten1 '(1(2)(3)4(5 6)7(8(9))))
;(1 2 3 4 5 6 7 8 (9))
;'done
;; flatten a list completely
(define x '(() 1 () (() 2 () (() 3 () (4 (()(((())))) 5 (())() 6) 7 ()) 8 ()) 9 ()))
(flatten x)
;'done
(xor #t #f)
(xor #f #t)
(xor #f #f)
(xor #t #t)
;'done
(last '(1 2 3))
;'done
(for-loop 1 3 (lambda (i)
(print i)
))
;'done
(foldr1 + '(1 2 3))
(foldl1 + '(1 2 3))
;'done
(unfoldr1 '+ '())
(unfoldr1 '+ '(1))
(unfoldr1 '+ '(1 2))
(unfoldr1 '+ '(1 2 3))
(unfoldr1 '+ '(1 2 3 4))
;'done
(unfoldl1 '+ '())
(unfoldl1 '+ '(1))
(unfoldl1 '+ '(1 2))
(unfoldl1 '+ '(1 2 3))
(unfoldl1 '+ '(1 2 3 4))
;'done
(filter positive? '(0 1 2 -1 -2))
(filter negative? '(0 1 2 -1 -2))
;(1 2)
;(-1 -2)
;'done
(interval 1 3)
;'done
(make-list 3 3)
;'done
(mod (interval 1 6) 3)
(mod 6 3)
;'done
(filter prime? (interval 1 13))
;'done
;; truncate works with big rational too
(= 5000000000000000000000000000000000000 (truncate 10000000000000000000000000000000000001/2))
;'done
;; return 1 if x^2==a mod b exists
;; else return -1
(quadres 661643 47)
(quadres 661643 3)
;1
;-1
;'done
;;
;; comp.lang.scheme
;; keyword: While macro with continuations
;;
(let ((i 0) (j 0))
(while (< i 2) (display i) (display ": ")
(display
(while (< j i) (display j) (display " ") (set! j (+ 1 j)) j)
)
(newline) (set! i (+ 1 i))
)
)
;0: #f
;1: 0 1
;'done
;;
;; http://www.ccs.neu.edu/home/dorai/t-y-scheme/t-y-scheme-Z-H-1.html
;;
(amb-run (print (number-between 1 3)))
;'done
(bag-of (gen-prime -5))
(bag-of (gen-prime 2))
(bag-of (gen-prime 13))
;()
;(2)
;(2 3 5 7 11 13)
;'done
(amb-run (print (number-between 1 3)))
(amb-run (print (amb-list '(4 5 6) )))
;'done
(amb-run
(let* ((x (amb-list '(3 4 5)))
(y (number-between x 6))
(z (list x y))
)
(print z)
)
)
;(3 3)
;(3 4)
;(3 5)
;(3 6)
;(4 4)
;(4 5)
;(4 6)
;(5 5)
;(5 6)
;'done
;; takes 0 1 -> #f #t
(binary->boolean '(0 1 0 1))
(foldr1 AND (binary->boolean '(0 1 0 1)))
(foldr1 OR (binary->boolean '(0 1 0 1)))
;(#f #t #f #t)
;#f
;#t
;'done
(print "# ----------")
(amb-run (let* ((A (number-between 0 1))
(B (number-between 0 1))
(C (number-between 0 1))
(D (number-between 0 1))
(E (number-between 0 1))
(F (number-between 0 1))
(p (foldr1 AND (list
(foldr1 OR (binary->boolean (list A B C)))
(foldr1 OR (binary->boolean (list D E F)))
))) ;; like system of equations
(q (foldr1 AND (list
(foldr1 OR (binary->boolean (list A B C)))
(foldr1 OR (binary->boolean (list D E F)))
(foldr1 OR (binary->boolean (list A B C D E F)))
))) ;; multiply two equations and add it to system
)
(if (not (eq? p q)) (print (list p q)) )
)
)
;'done
(print "# ----------")
(amb-run (let* ((A (number-between 0 1))
(B (number-between 0 1))
(C (number-between 0 1))
(D (number-between 0 1))
(E (number-between 0 1))
(F (number-between 0 1))
(p (foldr1 AND (list
(foldr1 OR (binary->boolean (list A B)))
(foldr1 OR (binary->boolean (list C D)))
(foldr1 OR (binary->boolean (list E F)))
))) ;; like system of equations
(q (foldr1 AND (list
(foldr1 OR (binary->boolean (list A B A B)))
(foldr1 OR (binary->boolean (list A B C D)))
(foldr1 OR (binary->boolean (list A B E F)))
(foldr1 OR (binary->boolean (list C D A B)))
(foldr1 OR (binary->boolean (list C D C D)))
(foldr1 OR (binary->boolean (list C D E F)))
(foldr1 OR (binary->boolean (list E F A B)))
(foldr1 OR (binary->boolean (list E F C D)))
(foldr1 OR (binary->boolean (list E F E F)))
))) ;; cross-product the system
)
(if (not (eq? p q)) (print (list p q)) )
)
)
;'done
;; http://mitpress.mit.edu/sicp/full-text/book/book.html
(memo-fib 100)
;354224848179261915075
;'done
;; http://www.cs.bgu.ac.il/~elhadad/scheme/merge.html
;; http://www.cs.bgu.ac.il/~elhadad/scheme/insertion.html
(insertion-sort < '(4 1 2 3 4 3 2 1))
;(1 1 2 2 3 3 4 4)
;'done
(map (lambda (a) (find-inverse-mod-p a 7)) (interval 1 6))
;(find-inverse-mod-p 2 8)
;'done
;; lst must have at least one element already
(define x '(1 2 3)) (cons! 0 x) x
;'done
;(0 1 2 3)
;(0 1 2 3)
(define x '(1)) (cons! 0 x) x
;(0 1)
;(0 1)
(pair? '())
(pair? (list))
(pair? (list 1))
;#f
;#f
;#t
;'done
(define x (list 1))
(set-cdr! x (list 2))
x
;'done
(pair? (cdr (list 1)))
;#f
;'done
(pair? '(1 2 3))
;'done
;; lst must have at least one element already
(define x '(1 2 3)) (append! x '(4)) x
;(1 2 3 4)
;(1 2 3 4)
(define x '(1)) (append! x '(4)) x
;(1 4)
;(1 4)
;'done
(nth-cdr 0 '(1 2 3))
(nth-cdr 1 '(1 2 3))
(nth-cdr 2 '(1 2 3))
(nth-cdr 3 '(1 2 3))
;(1 2 3)
;(2 3)
;(3)
;()
;'done
(take 0 '(1 2 3))
(take 1 '(1 2 3))
(take 2 '(1 2 3))
(take 3 '(1 2 3))
(take 4 '(1 2 3))
;()
;(1)
;(1 2)
;(1 2 3)
;(1 2 3)
;'done
(take-right 0 '(1 2 3))
(take-right 1 '(1 2 3))
(take-right 2 '(1 2 3))
(take-right 3 '(1 2 3))
(take-right 4 '(1 2 3))
;()
;(3)
;(2 3)
;(1 2 3)
;(1 2 3)
;'done
(take-right 1 '())
(take-right 2 '(1))
(take-right 3 '(1 2))
;()
;(1)
;(1 2)
;'done
(delete = 0 '(1 2 0 1 2 0))
;(1 2 1 2)
;'done
(contains? = 0 '(1 2 3))
(contains? = 1 '(1 2 3))
(contains? = 2 '(1 2 3))
(contains? = 3 '(1 2 3))
(contains? = 4 '(1 2 3))
;'done
(search-list 0 = 0 '(1 2 3))
(search-list 0 = 1 '(1 2 3))
(search-list 0 = 2 '(1 2 3))
(search-list 0 = 3 '(1 2 3))
(search-list 0 = 4 '(1 2 3))
(search-list 0 = 0 '())
(search-list 0 = 0 '(1))
(search-list 0 = 1 '(1))
;'done
(print "------")
(search-list 1 = 0 '(1 2 3))
(search-list 1 = 1 '(1 2 3))
(search-list 1 = 2 '(1 2 3))
(search-list 1 = 3 '(1 2 3))
(search-list 1 = 4 '(1 2 3))
(search-list 1 = 0 '())
(search-list 1 = 0 '(1))
(search-list 1 = 1 '(1))
;'done
(list->set = '(1 2 3 2 1))
(list->set = '(3 2 1 2 3))
;(1 2 3)
;(3 2 1)
;'done
;; delete elements from set1 using elements from set2
(set-minus = '(1 2 2 3 4 4 5 6 6 7 8 8 9 8 2) '(2 4 6 8))
(set-minus = '(1 2 2 3 4 4 5 6 6 7 8 8 9 8 2 1) '(2 4 6 8))
;(1 3 5 7 9)
;(1 3 5 7 9)
;(set-minus = '(1 2 3) '(4 5 6))
;'done
;; equal? is for set element comparison
(set-cmp? = (list 1 2 3 4 1 1 2 3 4 2 3 4 4 3 2 1) (list 2 3 2 3 2 4 2 3 4 4 3 2))
(set-cmp? = (list 1 2 3 4 1 1 2 3 4 2 3 4 4 3 2 1) (list 2 3 2 3 2 4 2 3 4 4 3 2 1))
;#f
;#t
(set-cmp? = '(1 2 3) '(1 2 3 4))
;#f
;'done
;; append zeroes to a list making it length n
(list->row 2 '(1 2 3))
(list->row 3 '(1 2 3))
(list->row 4 '(1 2 3))
(list->row 5 '(1 2 3))
;(1 2 3)
;(1 2 3)
;(1 2 3 0)
;(1 2 3 0 0)
;'done
(idx-interval0 '(1 2 3))
;'done
(swap 0 1 '(1 2 3))
(swap 0 2 '(1 2 3))
(swap 1 2 '(1 2 3))
;(2 1 3)
;(3 2 1)
;(1 3 2)
;'done
(define l '(1 2 3))
(swap! 0 1 l)
(swap! 0 2 l)
(swap! 1 2 l)
;(2 1 3)
;(3 1 2)
;(3 2 1)
(define m '((1 2 3)(4 5 6)(7 8 9)))
(swap! 0 1 m)
(swap! 0 2 m)
(swap! 1 2 m)
;'done
(define l '(1 2 3))
(list-set! l 0 4)
(list-set! l 1 5)
(list-set! l 2 6)
;'done
;; map a list to a function then sort
;; return list of pairs with original location (element . location)
(map-sort abs > '(-1 -2 -3 0 1 2))
(map-sort abs < '(-1 -2 -3 0 1 2))
;((3 . 2) (2 . 1) (2 . 5) (1 . 0) (1 . 4) (0 . 3))
;((0 . 3) (1 . 0) (1 . 4) (2 . 1) (2 . 5) (3 . 2))
;'done
(nth-apply 5 (lambda (x) (+ 1 x)) 1)
;'done
(nth-apply 1 rotate-right '(1 2 3 4))
(nth-apply 2 rotate-right '(1 2 3 4))
(nth-apply 3 rotate-right '(1 2 3 4))
(nth-apply 4 rotate-right '(1 2 3 4))
;(4 1 2 3)
;(3 4 1 2)
;(2 3 4 1)
;(1 2 3 4)
;'done
(nth-apply 1 rotate-left '(1 2 3 4))
(nth-apply 2 rotate-left '(1 2 3 4))
(nth-apply 3 rotate-left '(1 2 3 4))
(nth-apply 4 rotate-left '(1 2 3 4))
;(2 3 4 1)
;(3 4 1 2)
;(4 1 2 3)
;(1 2 3 4)
;'done
(rotate-left-n 0 '(1 2 3 4))
(rotate-left-n 1 '(1 2 3 4))
(rotate-left-n 2 '(1 2 3 4))
(rotate-left-n 3 '(1 2 3 4))
(rotate-left-n 4 '(1 2 3 4))
(rotate-right-n 0 '(1 2 3 4))
(rotate-right-n 1 '(1 2 3 4))
(rotate-right-n 2 '(1 2 3 4))
(rotate-right-n 3 '(1 2 3 4))
(rotate-right-n 4 '(1 2 3 4))
;'done
;; look no need for call/ec
(all-zero? zero? '(0 0 0 0))
(all-zero? zero? '(1 0 0 0))
(all-zero? zero? '(0 1 0 0))
(all-zero? zero? '(0 0 1 0))
(all-zero? zero? '(0 0 0 1))
;'done
(all-zero-matrix? zero? '((0 0)(0 0)))
(all-zero-matrix? zero? '((1 0)(0 0)))
(all-zero-matrix? zero? '((0 1)(0 0)))
(all-zero-matrix? zero? '((0 0)(1 0)))
(all-zero-matrix? zero? '((0 0)(0 1)))
;'done
(map-print (identity-matrix 1))
(map-print (identity-matrix 2))
(map-print (identity-matrix 3))
;'done
(define m '((1 2 3)(4 5 6)(7 8 9)))
(map-print (transpose m))
;(1 4 7)
;(2 5 8)
;(3 6 9)
;'done
(factorial 0)
(factorial 1)
(factorial 2)
(factorial 3)
(factorial 4)
(factorial 5)
(factorial 6)
(factorial 7)
;1
;1
;2
;6
;24
;120
;720
;5040
;'done
(cross-product '( (x1 x2) (y1 y2 y3) ))
;((x1 y1) (x1 y2) (x1 y3) (x2 y1) (x2 y2) (x2 y3))
;'done
;; form hankel matrix from a list
(map-print (hankel (interval 1 9)))
;(1 2 3 4 5)
;(2 3 4 5 6)
;(3 4 5 6 7)
;(4 5 6 7 8)
;(5 6 7 8 9)
;'done
(define m '((1 2 3)
(2 3 4)
(4 5 6))
)
(matrix-ref m 0 0)
(matrix-ref m 1 0)
(matrix-ref m 1 1)
;'done
(map-print m)
(map-print (matrix-set! m 0 0 9))
(map-print (matrix-set! m 1 0 8))
(map-print (matrix-set! m 1 1 7))
(map-print (matrix-set! m 1 2 6))
(map-print (matrix-set! m 2 2 5))
(map-print (matrix-set! m 2 1 4))
(map-print (matrix-set! m 2 0 3))
(map-print (matrix-set! m 0 2 2))
(map-print (matrix-set! m 0 1 1))
;(9 1 2)
;(8 7 6)
;(3 4 5)
;'done
(map-print (matrix-swap-columns! m 0 1))
(map-print (matrix-swap-columns! m 1 2))
(map-print (matrix-swap-columns! m 0 2))
;(9 2 1)
;(8 6 7)
;(3 5 4)
;'done
(map-print (matrix-swap-rows! m 0 1))
(map-print (matrix-swap-rows! m 1 2))
(map-print (matrix-swap-rows! m 0 2))
;'done
;(8 6 7)
;(9 2 1)
;(3 5 4)
;(void void void)
;(8 6 7)
;(3 5 4)
;(9 2 1)
;(void void void)
;(9 2 1)
;(3 5 4)
;(8 6 7)
;; only works for square matrix
(map-print (transpose! m))
(map-print (transpose! m))
;(9 2 1)
;(8 6 7)
;(3 5 4)
;'done
(map-print (matrix-row-op! m 1 (lambda (x) (- x 5))))
(map-print (matrix-row-op! m 2 (lambda (x) (- x 2))))
;(9 2 1)
;(3 1 2)
;(1 3 2)
;'done
(map-print (matrix-column-op! m 2 (lambda (x) (* x 2))))
(map-print (matrix-column-op! m 1 (lambda (x) (* x 3))))
;(9 6 2)
;(3 3 4)
;(1 9 4)
;'done
(matrix-get-column m 0)
(matrix-get-column m 1)
(matrix-get-column m 2)
;(9 3 1)
;(6 3 9)
;(2 4 4)
;'done
(map-print m)
(map-print (matrix-set-column! m 0 '(1 2 3)))
(map-print (matrix-set-column! m 1 '(4 5 6)))
(map-print (matrix-set-column! m 2 '(7 8 9)))
;(1 4 7)
;(2 5 8)
;(3 6 9)
;'done
(define m1 m)
(define m2 '((8 5 2)
(7 4 1)
(6 3 0)))
(map-print (matrix-add rational-field m1 m2))
;(9 9 9)
;(9 9 9)
;(9 9 9)
;'done
(define (inner-product field lst1 lst2)
(foldr1 (field 'add) (map (lambda (x y) ((field 'mul) x y)) lst1 lst2))
)
(inner-product rational-field '(1 2 3) '(4 5 6))
(inner-product rational-field '(1 2 3) '(2 2 2))
;32
;12
;'done
(to-maple-list (interval -5 5))
(to-maple-list '())
;[-5,-4,-3,-2,-1,0,1,2,3,4,5]
;[]
;'done
(to-maple-set (interval -5 5))
(to-maple-set '())
;{-5,-4,-3,-2,-1,0,1,2,3,4,5}
;{}
;'done
(to-maple-matrix '((1 2 3)(4 5 6)(7 8 9)))
(to-maple-matrix '((1 2)(4 5)(7 8)))
(to-maple-matrix '((1)(4)(7)))
(to-maple-matrix '((1 2 3)))
(to-maple-matrix '())
;[[1,2,3],[4,5,6],[7,8,9]]
;[[1,2],[4,5],[7,8]]
;[[1],[4],[7]]
;[[1,2,3]]
;[]
;'done
(to-maple-matrix m1)
(to-maple-matrix m2)
(map-print (matrix-mul rational-field m1 m2))
;(78 42 6)
;(99 54 9)
;(120 66 12)
;'done
;; only works for square matrix
(matrix-get-diagonal m1)
(matrix-get-diagonal m2)
;(1 5 9)
;(8 4 0)
;'done
;; only works for square matrix
(map-print m)
(map-print (matrix-set-diagonal! m '(1 1 1)))
;(1 4 7)
;(2 1 8)
;(3 6 1)
;'done
(map-print (matrix-apply (lambda (x) (- x 1)) m))
;(0 3 6)
;(1 0 7)
;(2 5 0)
;'done
(map-print m)
(map-print (matrix-apply! (lambda (x) (- x 1)) m))
;(0 3 6)
;(1 0 7)
;(2 5 0)
;'done
(map-print m2)
(map-print (matrix-zero-out-lower! rational-field m2))
;(8 5 2)
;(0 4 1)
;(0 0 0)
;'done
(map-print (matrix-zero-out-upper! rational-field m2))
;(8 0 0)
;(0 4 0)
;(0 0 0)
;'done
(map-print (matrix-swap-elements! m2 0 0 1 1))
;(4 0 0)
;(0 8 0)
;(0 0 0)
;'done
(define m '((0 9 0)(0 0 8)(7 0 0)) )
(map-print (matrix-permutate! m '(2 0 1)))
;(7 0 0)
;(0 9 0)
;(0 0 8)
;'done
(define m '((0 9 0)(0 0 8)(7 0 0)) )
(map-print (matrix-permutate m '(2 0 1)))
;(7 0 0)
;(0 9 0)
;(0 0 8)
;'done
(map-print (matrix-cat '((1 2)(1 2)) '((3 4 5)(3 4 5)) ))
;(1 2 3 4 5)
;(1 2 3 4 5)
(map-print (matrix-cat '((1 2)(1 2)(1 2)) '((3)(3)(3)) ))
;(1 2 3)
;(1 2 3)
;(1 2 3)
;'done
(define m '((3 4 5 6 7 8)(0 0 1 2 3 4)(0 0 2 2 2 2)) )
(map-print m)
(row-reduce rational-field m)
(map-print m)
;(3 4 5 6 7 8)
;(0 0 1 2 3 4)
;(0 0 2 2 2 2)
;(2 (3 2 0))
;(1 4/3 5/3 2 7/3 8/3)
;(0 0 1 2 3 4)
;(0 0 0 1 2 3)
;'done
(define m '((3 4 5 6 7 8)(0 0 1 2 3 4)) )
(RREF rational-field m)
(map-print m)
;(1 (2 0))
;(1 4/3 0 -4/3 -8/3 -4)
;(0 0 1 2 3 4)
(define m '((3 4 5 6 7 8)(0 0 1 2 3 4)(0 0 2 2 2 2)) )
(RREF rational-field m)
(map-print m)
;(2 (3 2 0))
;(1 4/3 0 0 0 0)
;(0 0 1 0 -1 -2)
;(0 0 0 1 2 3)
;'done
(inverse rational-field '((1 2 3)(4 4 5)(6 6 8)))
(inverse rational-field '((1 2 3)(4 5 6)(7 8 9)))
(inverse rational-field '((1 2 3)(4 4 4)(7 8 9)))
(inverse rational-field '((1 2 3)(4 4 5)(7 8 9)))
;((-1 -1 1) (1 5 -7/2) (0 -3 2))
;singular
;singular
;((-2/3 1 -1/3) (-1/6 -2 7/6) (2/3 1 -2/3))
;'done
(equal? '((1 2)(3 4)) '((1 2)(3 4)) )
(equal? '((1 2)(3 4)) '((1 2)(3 3)) )
;#t
;#f
;'done
(equal? '((1 (5) 2)(3 (5) 4)) '((1 (5) 2)(3 (5) 4)) )
(equal? '((1 (5) 2)(3 (5) 4)) '((1 (5) 2)(3 (4) 4)) )
;#t
;#f
;'done
;; The number of nonzero rows in the reduced row echelon form of a matrix A
;; is called the rank
;; Theorem. Consider the m*n linear system Ax=b where M=<A|b> is the augmented matrix.
;; 1. If rank(A)=rank(M)=n then unique solution
;; 2. If rank(A)=rank(M)<n then infinite number of solution
;; 3. If rank(A)<rank(M) then no solution
;;
;; determinant of triangular matrix is the product of the diagonal
;;
;; the inverse of a permutation matrix is simply its transpose
;;
;; use rref to find inverse (I A^-1)=rref(AI)
;;
;; If the determinant of a matrix is 0, the matrix is said to be singular
;;
;; not invertible <=> not full rank <=> singular <=> determinant=0
;;
;; http://www.math.uu.nl/people/bisselin/PSC/psc2_1.pdf
;;
;; all index starting with 1
;; lu-decomposition
;; input A
;; output (determinant p L U)
;; pA=LU
;; this function can fail, check if p is null first
;; only magnitude of determinant is correct (that is sign is not necessarily correct)
;; Note: LU decomposition is not unique: if A = LU, then A = L DD^(-1) U = (LD) (D^(-1)U)
;; Note: full-rank seems to give the same LU as Maple does
;;
;; full-rank <=> determinant is not 0
;; det(AB)=det(A)det(B)
;; det(rA)=r^n det(A)
;; det(A)^-1 = det(A^-1) iff A is full-rank
;;
(map-print (matrix-add rational-field '((1 2)(3 4))
'((1 1)(1 1)) ))
;(2 3)
;(4 5)
;'done
(map-print (matrix-sub rational-field '((1 2)(3 4))
'((1 1)(1 1)) ))
;(0 1)
;(2 3)
;'done
(map-print (matrix-mul rational-field '((1 2)(3 4))
'((5 6)(7 8)) ))
;(19 22)
;(43 50)
;'done
(map-print (matrix-mul rational-field '((1 2 3)(4 5 6)(7 8 9))
'((2 3 4)(5 6 7)(8 9 1)) ))
;(36 42 21)
;(81 96 57)
;(126 150 93)
;'done
(define (inc x) (if (list? x) (map (lambda (x) (+ x 1)) x) (+ x 1)))
(define (dec x) (if (list? x) (map (lambda (x) (- x 1)) x) (- x 1)))
(inc 1)(inc (list 1 2 3))
(dec 1)(dec (list 1 2 3))
;'done
(define do-test "no")
(define do-test "yes")
(define test-array-size (+ 2 (random 4)) )
(if (equal? "yes" do-test) (print 'MAPLE_BEGIN))
(print "interface(prettyprint=0):interface(screenwidth=infinity):")
(print "interface(warnlevel=0):with(linalg):")
(for-each (lambda (i)
(let* (;(m (map (lambda (x) (rotate-left-n x (dec (list->row 14 (convert-to-base i x)))))
; (inc (inc (interval 1 14)))
; ))
(m (map (lambda (x) (map (lambda (x) (- (random 11) 5)) (interval 1 test-array-size)))
(interval 1 test-array-size)))
(rm (list-copy m))
(im (list-copy m))
(lm (list-copy m))
(rr (RREF rational-field rm))
(ii (inverse rational-field im))
(lu (ludecomp rational-field lm))
(det (car lu))
)
(if (not (tree-cmp? = rm (rref m)))
(begin (map-print rm) (map-print (rref m)) (error "bug?")))
(print (string-append "m:=array(" (to-maple-matrix m) "):"
"rm:=array(" (to-maple-matrix rm) "):"
"mydet:=" (number->string det) ":"
"myrank:=" (number->string (+ 1 (car rr))) ":"
"if not iszero(evalm(rref(m)-rm)) then print(BUG1) fi:"
"if not (abs(det(m))-abs(mydet))=0 then print(BUG2) fi:"
"if not (rank(m)-myrank)=0 then print(BUG3) fi:"
))
(if (xor (eq? 'singular ii) (= 0 det)) (error "bug?")) ;; det=0 <=> singular
(if (not (eq? 'singular ii)) ;; check pA=LU
(if (not (equal? (matrix-mul rational-field (third lu) (fourth lu))
(matrix-permutate m (second lu)))) (error "bug?"))
)
(if (not (eq? 'singular ii))
(print (string-append
"ii:=array(" (to-maple-matrix ii) "):"
"if not iszero(evalm(inverse(m)-ii)) then print(BUG4) fi:"
;; ludecomp is not unique
;"myL:=" (to-maple-matrix (third lu)) ":"
;"myU:=" (to-maple-matrix (fourth lu)) ":"
;"myp:=" (to-maple-list (second lu)) ":"
;"LUdecomp(m,P='p',L='l',U='u'):"
;"if not iszero(evalm(myL-l)) then print(myL,l,BUGl,p,myp) fi:"
;"if not iszero(evalm(myU-u)) then print(myU,u,BUGu,p,myp) fi:"
))
(print (string-append "if not det(m)=0 then print(BUGdet) fi:"))
)
)
) (if (equal? "yes" do-test)
(interval (expt 2 9) (+ (expt 2 9) (expt 2 test-array-size))) (interval 2 1)) )
(if (equal? "yes" do-test) (print 'MAPLE_END))
;'done
; cat /tmp/maple.txt
; cat /tmp/maple.txt | maple -q
(define m (hankel '(0 1 2 7 20 61 182 547 1640 4921)))
(map-print m)
(map-print (rref m))
(RREF rational-field m)
(map-print m)
;(1 0 3 6 21)
;(0 1 2 7 20) <-
;(0 0 0 0 0)
;(0 0 0 0 0)
;(0 0 0 0 0)
; ^
; ^
;'done
(matrix-last-column '((1 2 3)(4 5 6)(7 8 9)))
;(3 6 9)
;'done
(factorial 55)
;'done
;;
;; n : number of initial conditions (variables)
;; d : degree
;; m : matrix size
;; v : number of verification terms
;; t : total terms required
;;
;(solve-confs max-number-of-terms max-number-of-variables maximum-degree)
;(define all-confs-248 (bag-of (solve-confs 248 8 8))) ;; used to be 8 128
all-confs-248
;'done
(for-each (lambda (t) (print (list t (find-conf t)))) (interval 5 248))
;'done
(newline)
(define f (memoize (lambda (n) (cond ((= n 1) 0) ((= n 2) 1) (else 2)))))
(map f (interval 1 300))
;'done
(newline)
(define s '(f32 0 1 2 7 20 61 182 547 1640 4921))
(hankel-solver s)
;; non-zero-pattern: ((3 f(n-2)) (2 f(n-1)))
;; that is f(n)= 3*f(n-2) + 2*f(n-1)
;(map f (interval 1 10)) ;; this setup has problem, f is not reuse-able
;'done
(newline)
(define s '(f32 0 1 2 7 20 61 182 547 1640 4921))
(multivariate-solver s)
;; non-zero-pattern: ( (3 (f(n-2)^1 f(n-1)^0)) (2 (f(n-2)^0 f(n-1)^1)) )
;; that is f(n)= 3 *f(n-2) + 2 *f(n-1)
;(map f (interval 1 10)) ;; this setup has problem, f is not reuse-able
;'done
(newline)
(define s '(A000008 1 1 2 2 3 4 5 6 7 8 11 12 15 16 19 22 25 28 31 34 40 43 49 52 58 64 70 76
82 88 98 104 114 120 130 140 150 160 170 180 195 205 220 230 245 260 275 290 305 320 341 356
377 392 413 434 455 476 497 518 546))
s
(length s)
(solve-seq s)
;(map f (interval 1 12)) ;; this setup has problem, f is not reuse-able
;'done
;; cat stripped | sed "/A131085.*/d" | sed "/A127569.*/d" > seq.txt
;; grep A131085 seq.txt
;; grep A127569 seq.txt
;; cat seq.txt | sed "s/,/ /g" | sed "s/^/(/" | sed "s/$/)/" > seq-test.txt
;(define do-test "yes")
;(define (do-seq-test)
; (with-input-from-file "sequence/seq-test.txt"
; (lambda ()
; (let loop ()
; (let ((s (read)))
; (if (not (eof-object? s))
; (begin
; (solve-seq s)
; (loop)
; )))))))
;(if (equal? "yes" do-test) (do-seq-test))
;done
;; grep out /tmp/0.txt |sed "s/.*terms......//" |sed "s/(.*//"
(newline)
(map-print (powermod-table 7))
;(1 1 1 1 1 1)
;(2 4 1 2 4 1)
;(3 2 6 4 5 1)
;(4 2 1 4 2 1)
;(5 4 6 2 3 1)
;(6 1 6 1 6 1)
(rank (powermod-table 7))
(RANK rational-field (powermod-table 7))
;; full rank if n is prime,
;'done
;; (n>=1) n=x^y for some y>=2
(filter (lambda (n) (perfect-power-of? n 2)) (interval 1 16))
(filter (lambda (n) (perfect-power-of? n 3)) (interval 1 27))
;(1 2 4 8 16)
;(1 3 9 27)
;'done
(map log2 (interval 0 16))
(convert-to-base 16 2)
;(0 0 1 1 2 2 2 2 3 3 3 3 3 3 3 3 4)
;(0 0 0 0 1)
;; NOTE: log2 + 1 = number of bits
;'done
(map factor (interval -5 5))
;((-1 5 1) (-1 2 2 1) (-1 3 1) (-1 2 1) (-1 1) (0) (1) (2 1) (3 1) (2 2 1) (5 1))
;'done
(define do-test "no")
(for-each (lambda (x)
(if (not (= (foldr1 * (factor x)) x)) (error "bug?"))
) (if (equal? "yes" do-test) (interval -100 100) (interval 2 1)) )
;'done
(mdeg '(1 2 3))
;'done
(lex '(3 2 1) '(5 2 4))
(lex '(3 2 1) '(1 2 4)) ; => #t
(lex '(2 1 3) '(1 4 2)) ; => #t
;(lex '() '(1 2 4))
;(lex '(3 2 1) '())
;(lex '() '())
;'done
(grlex '(3 2 1) '(1 2 4))
(grlex '(3 2 1) '(5 2 4))
(grlex '(2 4 1) '(1 6 0)) ; => #t
(grlex '(3 2 3) '(2 4 2)) ; => #t
;(grlex '(2 4 1) '())
;(grlex '() '(1 6 0))
;(grlex '() '())
;'done
(grevlex '(3 2 1) '(1 2 4))
(grevlex '(3 2 1) '(5 2 4))
(grevlex '(2 4 1) '(1 6 0))
(grevlex '(1 3 1) '(1 2 2)) ; => #t
(grevlex '(2 4 2) '(2 3 3)) ; => #t
;(grevlex '() '(1 6 0))
;(grevlex '(2 4 1) '())
;(grevlex '() '())
;'done
(kth-elim 1 '(2 0 1) '(1 2 0))
(kth-elim 2 '(1 2 0) '(2 0 1))
(kth-elim 3 '(1 2 2) '(2 1 1))
(kth-elim 3 '(1 2 0) '(2 0 1))
;#t
;#t
;#t
;#t
;'done
(define kth1 (lambda (x y) (kth-elim 1 x y)) )
(define kth2 (lambda (x y) (kth-elim 2 x y)) )
(define kth3 (lambda (x y) (kth-elim 3 x y)) )
;; do a proper test of term ordering
;; (~(x > y)) and (~(y > x)) => (x <= y) and (y <= x) => x=y
;; (~(x < y)) and (~(y < x)) => (x >= y) and (y >= x) => x=y
;; (x <= y) and (y <= x) => x=y
;; (x >= y) and (y >= x) => x=y
(define x (bag-of (list (number-between -2 2) (number-between -2 2) (number-between -2 2))))
x
;'done
(print "lex")
(define y (insertion-sort (lambda (x y) (lex x y)) x)) ;y
(for-each (lambda (x y)
(if (and (not (lex x y)) (not (lex y x)))
(print (list x y))
)
) (take (- (length y) 1) y) (take (- (length y) 1) (rotate-left y)) )
;; ok lex has unique term ordering
(print "rlex")
(define y (insertion-sort (lambda (x y) (rlex x y)) x)) ;y
(for-each (lambda (x y)
(if (and (not (rlex x y)) (not (rlex y x)))
(print (list x y))
)
) (take (- (length y) 1) y) (take (- (length y) 1) (rotate-left y)) )
;; ok rlex has unique term ordering
(print "grlex")
(define y (insertion-sort (lambda (x y) (grlex x y)) x)) ;y
(for-each (lambda (x y)
(if (and (not (grlex x y)) (not (grlex y x)))
(print (list x y))
)
) (take (- (length y) 1) y) (take (- (length y) 1) (rotate-left y)) )
;; ok grlex has unique term ordering
(print "grevlex")
(define y (insertion-sort (lambda (x y) (grevlex x y)) x)) ;y
(for-each (lambda (x y)
(if (and (not (grevlex x y)) (not (grevlex y x)))
(print (list x y))
)
) (take (- (length y) 1) y) (take (- (length y) 1) (rotate-left y)) )
;; ok grevlex has unique term ordering
(print "kth1")
(define y (insertion-sort (lambda (x y) (kth1 x y)) x)) ;y
(for-each (lambda (x y)
(if (and (not (kth1 x y)) (not (kth1 y x)))
(print (list x y))
)
) (take (- (length y) 1) y) (take (- (length y) 1) (rotate-left y)) )
;; ok kth1 has unique term ordering
(print "kth2")
(define y (insertion-sort (lambda (x y) (kth2 x y)) x)) ;y
(for-each (lambda (x y)
(if (and (not (kth2 x y)) (not (kth2 y x)))
(print (list x y))
)
) (take (- (length y) 1) y) (take (- (length y) 1) (rotate-left y)) )
;; ok kth2 has unique term ordering
(print "kth3")
(define y (insertion-sort (lambda (x y) (kth3 x y)) x)) ;y
(for-each (lambda (x y)
(if (and (not (kth3 x y)) (not (kth3 y x)))
(print (list x y))
)
) (take (- (length y) 1) y) (take (- (length y) 1) (rotate-left y)) )
;; ok kth3 has unique term ordering
;; once you have "unique" ordering, reduction becomes like univariate case.
;; see what grev looks like
(define x (bag-of (list (number-between 0 2) (number-between 0 2) (number-between 0 2)))) ;x
(define y (insertion-sort (lambda (x y) (lex x y)) x)) (map (lambda (m) (foldr1 + m)) y)
(define y (insertion-sort (lambda (x y) (rlex x y)) x)) (map (lambda (m) (foldr1 + m)) y)
(define y (insertion-sort (lambda (x y) (grlex x y)) x)) (map (lambda (m) (foldr1 + m)) y)
(define y (insertion-sort (lambda (x y) (grevlex x y)) x)) (map (lambda (m) (foldr1 + m)) y)
;; grlex and grevlex can be used if total degree matters
;(6 5 4 5 4 3 4 3 2 5 4 3 4 3 2 3 2 1 4 3 2 3 2 1 2 1 0)
;(0 1 2 1 2 3 2 3 4 1 2 3 2 3 4 3 4 5 2 3 4 3 4 5 4 5 6)
;(6 5 5 5 4 4 4 4 4 4 3 3 3 3 3 3 3 2 2 2 2 2 2 1 1 1 0)
;(6 5 5 5 4 4 4 4 4 4 3 3 3 3 3 3 3 2 2 2 2 2 2 1 1 1 0)
;'done
(last-char "123")
(last-char "abc")
;'done
(chop "abc123" 0)
(chop "abc123" 1)
(chop "abc123" 2)
;abc123
;abc12
;abc1
;'done
(term-string lex-rational-xyz '(5 1 2 3) )
(term-string lex-rational-xyz '(1 1 2 3) )
(term-string lex-rational-xyz '(1 1 0 0) )
(term-string lex-rational-xyz '(1 0 1 0) )
(term-string lex-rational-xyz '(5 0 0 1) )
(term-string lex-rational-xyz '(1 0 0 0) )
(term-string lex-rational-xyz '(6 0 0 0) )
(term-string lex-rational-xyz '(5 0 5 0) )
(term-string lex-rational-xyz '(0 0 0 0) )
;(5*x*y^2*z^3)
;(x*y^2*z^3)
;(x)
;(y)
;(5*z)
;(1)
;(6)
;(5*y^5)
;(0)
;'done
(poly-string lex-rational-xyz '((1 2 0 0) (1 0 2 0) (1 0 0 2) (-1 0 0 0)))
(poly-string lex-rational-xyz '())
;(x^2)+(y^2)+(z^2)+(-1)
;0
;'done
(polys-string lex-rational-xyz '(
((1 2 0 0) (1 0 2 0) (1 0 0 2) (-1 0 0 0))
((1 2 0 0) (1 1 2 0) (1 0 0 1) (-1 0 0 0))
((1 2 0 1) (1 2 2 5) (1 1 0 1) (-1 0 0 0))
))
(polys-string lex-rational-xyz '())
;[(x^2)+(y^2)+(z^2)+(-1),(x^2)+(x*y^2)+(z)+(-1),(x^2*z)+(x^2*y^2*z^5)+(x*z)+(-1)]
;[]
;'done
(term-list-string lex-rational-xyz '(1 2 3 4))
;(1 2 3 4)
;'done
(poly-list-string lex-rational-xyz '((1 2 0 0)(1 0 2 0)(1 0 0 2)(-1 0 0 0)) )
;((1 2 0 0)(1 0 2 0)(1 0 0 2)(-1 0 0 0))
;'done
(define S (list '((1 2 0 0) (1 0 2 0) (1 0 0 2) (-1 0 0 0))
'((1 2 0 0) (1 0 2 0) (1 0 0 2) (-2 1 0 0))
'((2 1 0 0) (-3 0 1 0) (-1 0 0 1)) ))
(map-print (polys-list-string lex-rational-xyz S))
;#
;# ((1 2 0 0)(1 0 2 0)(1 0 0 2)(-1 0 0 0))
;# ((1 2 0 0)(1 0 2 0)(1 0 0 2)(-2 1 0 0))
;# ((2 1 0 0)(-3 0 1 0)(-1 0 0 1))
;#
;'done
(poly-string lex-rational-xyz (poly-sort! lex-rational-xyz '((1 1 5 2) (1 2 3 3) (1 3 0 0)) ))
;(x^3)+(x^2*y^3*z^3)+(x*y^5*z^2)
;'done
(TaddT rational-field '(2 1 2 3) '(3 4 5 6))
;(3 4 5 6)
(TaddT rational-field '(2 1 2 3) '(3 1 2 3))
;(5 1 2 3)
(TaddT rational-field '(-1 1 2 3) '(1 1 2 3))
;0
;'done
(TmulT rational-field '(2 1 2 3) '(3 4 5 6))
(TmulT rational-field '(0 1 2 3) '(3 4 5 6))
(TmulT rational-field '(2 1 2 3) '(0 4 5 6))
;(6 5 7 9)
;0
;0
;'done
(TmulP rational-field '(2 1 2 3) '((2 2 8 0)(-3 5 1 4)(1 2 3 4)(-1 1 4 0)))
;((4 3 10 3) (-6 6 3 7) (2 3 5 7) (-2 2 6 3))
(TmulP rational-field '(0 1 2 3) '((2 2 8 0)(-3 5 1 4)(1 2 3 4)(-1 1 4 0)))
;()
(TmulP rational-field '(2 1 2 3) '())
;()
;; null term makes no sense, should trigger error
;(TmulP rational-field '() '((2 2 8 0)(-3 5 1 4)(1 2 3 4)(-1 1 4 0)))
;'done
;; term add "onto" poly
(TaddP rational-field '(2 1 2 3) '((2 2 8 0)(-3 5 1 4)(1 2 3 4)(-1 1 4 0)))
;((2 1 2 3) (2 2 8 0) (-3 5 1 4) (1 2 3 4) (-1 1 4 0))
(TaddP rational-field '(-2 2 8 0) '((2 2 8 0)(-3 5 1 4)(1 2 3 4)(-1 1 4 0)))
;((-3 5 1 4) (1 2 3 4) (-1 1 4 0))
(TaddP rational-field '(3 5 1 4) '((2 2 8 0)(-3 5 1 4)(1 2 3 4)(-1 1 4 0)))
;((2 2 8 0) (1 2 3 4) (-1 1 4 0))
(TaddP rational-field '(0 5 1 4) '((2 2 8 0)(-3 5 1 4)(1 2 3 4)(-1 1 4 0)))
;((2 2 8 0) (-3 5 1 4) (1 2 3 4) (-1 1 4 0))
(TaddP rational-field '(0 5 1 4) '())
;()
(TaddP rational-field '(1 5 1 4) '())
;((1 5 1 4))
(TaddP rational-field '(0 0 0 0) '((1 1 2 3)(2 1 2 3)(3 1 2 3)(4 1 2 3)))
;((1 1 2 3) (2 1 2 3) (3 1 2 3) (4 1 2 3))
;; null term makes no sense, should trigger error
;(TaddP rational-field '() '(1 5 1 4))
;'done
(scan-out-0-terms rational-field '(0(0 2 8 0)0(0 5 1 4)0(1 2 3 4)0(0 1 4 0)0) )
;((1 2 3 4))
;'done
;; three levels of 0:
;; 1. 0-polynomial '()
;; 2. 0-term 0
;; 3. 0-coeff (0 ...)
(poly-add rational-field '((2 2 8 0)(-3 5 1 4)) '((1 2 3 4)(-1 1 4 0)))
;((-3 5 1 4) (2 2 8 0) (1 2 3 4) (-1 1 4 0))
(poly-add rational-field '((-1 2 3 4)(-3 5 1 4)) '((1 2 3 4)(-1 1 4 0)))
;((-3 5 1 4) (-1 1 4 0))
(poly-add rational-field '((0 1 2 3)(-1 2 3 4)(-3 5 1 4)) '((1 2 3 4)(-1 1 4 0)))
(poly-add rational-field '((0 1 2 3)(-1 2 3 4)(-3 5 1 4)) '((0 1 2 3)(1 2 3 4)(-1 1 4 0)))
;((-3 5 1 4) (-1 1 4 0))
;((-3 5 1 4) (-1 1 4 0))
(poly-add rational-field '(0 (0 1 2 3)(-1 2 3 4)(-3 5 1 4)) '((0 1 2 3)(1 2 3 4)(-1 1 4 0)))
(poly-add rational-field '(0 (0 1 2 3)(-1 2 3 4)(-3 5 1 4)) '(0 (0 1 2 3)(1 2 3 4)(-1 1 4 0)))
;((-3 5 1 4) (-1 1 4 0))
;((-3 5 1 4) (-1 1 4 0))
(poly-add rational-field '((0 1 2 3)(-1 2 3 4)(1 1 4 0)) '((1 2 3 4)(-1 1 4 0)))
;()
(poly-add rational-field '((0 1 2 3)(-1 2 3 4)(1 1 4 0)) '((1 2 3 4)(-1 1 4 0)(0 1 2 3)))
;()
(poly-add rational-field '((2 2 8 0)(-3 5 1 4)) '((1 2 3 4)(-1 1 4 0)(0 1 2 3)))
(poly-add rational-field '((-1 2 3 4)(-3 5 1 4)) '((1 2 3 4)(-1 1 4 0)(0 1 2 3)))
(poly-add rational-field '((0 1 2 3)(-1 2 3 4)(-3 5 1 4)) '((1 2 3 4)(-1 1 4 0)(0 1 2 3)))
;((-3 5 1 4) (2 2 8 0) (1 2 3 4) (-1 1 4 0))
;((-3 5 1 4) (-1 1 4 0))
;((-3 5 1 4) (-1 1 4 0))
(poly-add rational-field '((0 0 0 0)) '((1 1 2 3)(2 1 2 3)(3 1 2 3)(4 1 2 3)) )
(poly-add rational-field '((1 1 2 3)(2 1 2 3)(3 1 2 3)(4 1 2 3)) '((0 0 0 0)) )
(poly-add rational-field '((1 1 2 3)(2 1 2 3)(3 1 2 3)(-6 1 2 3)) '((0 0 0 0)) )
(poly-add rational-field '() '((0 0 0 0)) )
(poly-add rational-field '((1 1 2 3)(2 1 2 3)(3 1 2 3)(4 1 2 3)) '() )
(poly-add rational-field '((1 1 2 3)(2 1 2 3)(3 1 2 3)(-6 1 2 3)) '() )
;((1 1 2 3) (2 1 2 3) (3 1 2 3) (4 1 2 3))
;((10 1 2 3))
;()
;()
;((10 1 2 3))
;()
(poly-add rational-field '((84/19 7)(84/19 5)) '((24/19 8)(24/19 5)) )
;((84/19 7) (24/19 8) (108/19 5))
(poly-add rational-field '((80/19 4)(80/19 1)) '((48/19 3)(48/19 1)))
;((80/19 4) (48/19 3) (128/19 1))
(poly-add rational-field
'((4/19 7)(4/19 7)(4/19 7)(4/19 7)(4/19 5)(4/19 5)(4/19 5)(4/19 5)) '() )
;'done
(poly-string lex-rational-xyz '((0 1 2 3)(-1 2 3 4)(1 1 4 0)))
(poly-string lex-rational-xyz '((1 2 3 4)(-1 1 4 0)(0 1 2 3)))
;(0*x*y^2*z^3)+(-1*x^2*y^3*z^4)+(x*y^4)
;(x^2*y^3*z^4)+(-1*x*y^4)+(0*x*y^2*z^3)
(poly-string lex-rational-xyz
(poly-mul rational-field '((0 1 2 3)(-1 2 3 4)(1 1 4 0)) '((1 2 3 4)(-1 1 4 0)(0 1 2 3)))
)
;(-1*x^4*y^6*z^8)+(2*x^3*y^7*z^4)+(-1*x^2*y^8)
;maple : -x^4*y^6*z^8+2*x^3*y^7*z^4-x^2*y^8
;'done
(poly-negate rational-field '((0 1 2 3)(-1 2 3 4)(1 1 4 0)))
;((0 1 2 3) (1 2 3 4) (-1 1 4 0))
;'done
(poly-sub rational-field '((-1 2 3 4)(1 1 4 0)) '((1 2 3 4)(-1 1 4 0)))
(poly-sub rational-field '((-1 2 3 4)(1 1 4 0)) '((-1 2 3 4)(1 1 4 0)))
;((-2 2 3 4) (2 1 4 0))
;()
;(poly-sub rational-field '() '())
;'done
(TdivT? lex-rational-xyz '(1 1 2 3) '(2 1 2 3))
(TdivT? lex-rational-xyz '(1 2 2 3) '(2 1 2 3))
(TdivT? lex-rational-xyz '(1 0 2 3) '(2 1 2 3))
(TdivT? lex-rational-xyz '(1 1 1 3) '(2 1 2 3))
;#t
;#t
;#f
;#f
;'done
(TdivT rational-field '(2 2 2 3) '(4 1 2 3))
(TdivT rational-field '(2 0 2 3) '(4 1 2 3))
;(1/2 1 0 0)
;(1/2 -1 0 0)
;'done
;;
;; f = q g + r
;; http://www.geocities.com/CapeCanaveral/Hall/3131/
;; Input: f, g
;; Output: q, r
;; q := 0; r := f
;; WHILE (r<>0 AND LT(g) divides LT(r)) DO
;; q := q + LT(r)/LT(g)
;; r := r - (LT(r)/LT(g))g
;; note: at every step f = q g + r holds
;;
;; convert a number to an univariate polynomial
(polys-string lex-rational-xyz (map (lambda (x) (num-to-poly x 2)) (interval 0 16)))
;'done
(monic? lex-rational-xyz '((2 2 2 3)(4 1 2 3)) )
(monic? lex-rational-xyz '((1 2 2 3)(4 1 2 3)) )
;#f
;#t
;'done
(poly-string lex-rational-xyz (num-to-poly 5125 5))
(poly-string lex-rational-xyz (num-to-poly 15125 5))
;(x^3)+(3*x^4)+(x^5)
;(x^3)+(4*x^4)+(4*x^5)
(polys-string lex-rational-xyz (poly-div lex-rational-xyz
(num-to-poly 5125 5) (num-to-poly 15125 5)))
(polys-string lex-rational-xyz (poly-div lex-rational-xyz
(num-to-poly 15125 5) (num-to-poly 5125 5)))
;[(2*x^4)+(3/4*x^3),(1/4)]
;[(-8*x^4)+(-3*x^3),(4)]
;'done
;; prepare polynomial (merge terms)
(poly-prep rational-field '((4/19 7)(4/19 7)(4/19 7)(4/19 7)(4/19 5)(4/19 5)(4/19 5)(4/19 5)) )
;((16/19 5) (16/19 7))
;'done
(define numtests 32)
;; (random-poly field nsymbols nterms) ;; n symbols 1-n terms
(newline)
(define test-polys
(map (lambda (i) (random-poly rational-field 3 6)) (interval 1 (+ 128 numtests)))
)
(define test-polys (filter not-null? test-polys))
(define test-polys (filter not-constant-poly? test-polys))
;(map-print (map (lambda (x) (poly-string lex-rational-xyz x)) test-polys))
;(map-print test-polys)
(define test-polys-len (length test-polys))
test-polys-len
(list->set equal? (map length test-polys))
;'done
;; be careful with test cases, not to have duplicate monomials
(define do-test "no")
(define do-test "yes")
(if (equal? "yes" do-test) (print 'MAPLE_BEGIN))
(print "interface(prettyprint=0):interface(screenwidth=infinity):")
(print "interface(warnlevel=0):with(Groebner):")
(for-loop 0 (if (equal? "yes" do-test) numtests -1) (lambda (i)
(let* ((a (poly-prep rational-field (map (lambda (t) (cons (/ (car t) 19) (take 1 (cdr t))))
(list-ref test-polys (mod (square i) test-polys-len)))))
(b (poly-prep rational-field (map (lambda (t) (cons (/ (car t) 19) (take 1 (cdr t))))
(list-ref test-polys (mod (square i) test-polys-len)))))
(void (if (with-duplicate-monomials? a) (error (poly-list-string a))))
(void (if (with-duplicate-monomials? b) (error (poly-list-string b))))
(r1 (poly-add rational-field a b))
(r2 (poly-sub rational-field a b))
(r3 (poly-mul rational-field a b))
(r (car (poly-div lex-rational-xyz a b)))
(q (cadr (poly-div lex-rational-xyz a b)))
)
(print (string-append "i:=" (number->string i) ":"
"a:=" (poly-string lex-rational-xyz a) ":"
"b:=" (poly-string lex-rational-xyz b) ":"
"r1:=" (poly-string lex-rational-xyz r1) ":"
"r2:=" (poly-string lex-rational-xyz r2) ":"
"r3:=" (poly-string lex-rational-xyz r3) ":"
"q:=" (poly-string lex-rational-xyz q) ":"
"r:=" (poly-string lex-rational-xyz r) ":"
"if not simplify(expand(a+b)-r1)=0 then print(i,a,b,BUG1,expand(a+b),r1) fi:"
"if not simplify(expand(a-b)-r2)=0 then print(i,a,b,BUG2,expand(a-b),r2) fi:"
"if not simplify(expand(a*b)-r3)=0 then print(i,a,b,BUG3,expand(a*b),r3) fi:"
"if not simplify(expand(quo(a,b,x)-q))=0 then print(i,a,b,BUG4,quo(a,b,x),q) fi:"
"if not simplify(expand(rem(a,b,x)-r))=0 then print(i,a,b,BUG5,rem(a,b,x),r) fi:"
"if not simplify(b*q+r-a)=0 then print(BUG6) fi:"
))
)
))
(if (equal? "yes" do-test) (print 'MAPLE_END))
;'done
;; be careful with test cases, not to have duplicate monomials
(define do-test "no")
(define do-test "yes")
(if (equal? "yes" do-test) (print 'MAPLE_BEGIN))
(print "interface(prettyprint=0):interface(screenwidth=infinity):")
(print "interface(warnlevel=0):with(Groebner):")
(for-loop 0 (if (equal? "yes" do-test) numtests -1) (lambda (i)
(let* ((a (poly-prep rational-field (map (lambda (t) (cons (car t) (take 1 (cdr t))))
(list-ref test-polys (mod (square i) test-polys-len)))))
(b (poly-prep rational-field (map (lambda (t) (cons (car t) (take 1 (cdr t))))
(list-ref test-polys (mod (square i) test-polys-len)))))
(void (if (with-duplicate-monomials? a) (error (poly-list-string a))))
(void (if (with-duplicate-monomials? b) (error (poly-list-string b))))
(r1 (poly-add rational-field a b))
(r2 (poly-sub rational-field a b))
(r3 (poly-mul rational-field a b))
(r (car (poly-div lex-rational-xyz a b)))
(q (cadr (poly-div lex-rational-xyz a b)))
)
(print (string-append "i:=" (number->string i) ":"
"a:=" (poly-string lex-rational-xyz a) ":"
"b:=" (poly-string lex-rational-xyz b) ":"
"r1:=" (poly-string lex-rational-xyz r1) ":"
"r2:=" (poly-string lex-rational-xyz r2) ":"
"r3:=" (poly-string lex-rational-xyz r3) ":"
"q:=" (poly-string lex-rational-xyz q) ":"
"r:=" (poly-string lex-rational-xyz r) ":"
"if not simplify(expand(a+b)-r1)=0 then print(i,a,b,BUG1,expand(a+b),r1) fi:"
"if not simplify(expand(a-b)-r2)=0 then print(i,a,b,BUG2,expand(a-b),r2) fi:"
"if not simplify(expand(a*b)-r3)=0 then print(i,a,b,BUG3,expand(a*b),r3) fi:"
"if not simplify(expand(quo(a,b,x)-q))=0 then print(i,a,b,BUG4,quo(a,b,x),q) fi:"
"if not simplify(expand(rem(a,b,x)-r))=0 then print(i,a,b,BUG5,rem(a,b,x),r) fi:"
"if not simplify(b*q+r-a)=0 then print(BUG6) fi:"
))
)
))
(if (equal? "yes" do-test) (print 'MAPLE_END))
;'done
;; be careful with test cases, not to have duplicate monomials
(define do-test "no")
(define do-test "yes")
(if (equal? "yes" do-test) (print 'MAPLE_BEGIN))
(print "interface(prettyprint=0):interface(screenwidth=infinity):")
(print "interface(warnlevel=0):with(Groebner):")
(for-loop 0 (if (equal? "yes" do-test) numtests -1) (lambda (i)
(let* ((a (poly-prep Zp17 (map (lambda (t) (cons (car t) (take 1 (cdr t))))
(list-ref test-polys (mod (square i) test-polys-len)))))
(b (poly-prep Zp17 (map (lambda (t) (cons (car t) (take 1 (cdr t))))
(list-ref test-polys (mod (square i) test-polys-len)))))
(void (if (with-duplicate-monomials? a) (error (poly-list-string a))))
(void (if (with-duplicate-monomials? b) (error (poly-list-string b))))
(r1 (poly-add Zp17 a b))
(r2 (poly-sub Zp17 a b))
(r3 (poly-mul Zp17 a b))
(r (car (poly-div lex-Zp17-xyz a b)))
(q (cadr (poly-div lex-Zp17-xyz a b)))
)
(print (string-append "i:=" (number->string i) ":"
"a:=" (poly-string lex-Zp17-xyz a) ":"
"b:=" (poly-string lex-Zp17-xyz b) ":"
"r1:=" (poly-string lex-Zp17-xyz r1) ":"
"r2:=" (poly-string lex-Zp17-xyz r2) ":"
"r3:=" (poly-string lex-Zp17-xyz r3) ":"
"q:=" (poly-string lex-Zp17-xyz q) ":"
"r:=" (poly-string lex-Zp17-xyz r) ":"
"Q:=expand(Quo(a,b,x) mod 17):"
"R:=expand(Rem(a,b,x) mod 17):"
"R1:=expand(a+b) mod 17:"
"R2:=expand(a-b) mod 17:"
"R3:=expand(a*b) mod 17:"
"if not simplify(R1-r1)=0 then print(i,a,b,BUG1,R1,r1) fi:"
"if not simplify(R2-r2)=0 then print(i,a,b,BUG2,R2,r2) fi:"
"if not simplify(R3-r3)=0 then print(i,a,b,BUG3,R3,r3) fi:"
"if not simplify(Q-q)=0 then print(i,a,b,BUG4,Q,q) fi:"
"if not simplify(R-r)=0 then print(i,a,b,BUG5,R,r) fi:"
"if not (expand(b*q+r-a) mod 17)=0 then print(BUG6,expand(b*q+r-a) mod 17) fi:"
))
)
))
(if (equal? "yes" do-test) (print 'MAPLE_END))
;'done
(poly-string lex-rational-xyz (num-to-poly 5125 5))
(poly-string lex-rational-xyz (num-to-poly 15125 5))
(poly-string lex-rational-xyz (cadr (poly-gdiv lex-rational-xyz
(list (num-to-poly 5125 5) (num-to-poly 15125 5)) )))
(poly-string lex-rational-xyz (car (poly-gdiv lex-rational-xyz
(list (num-to-poly 5125 5) (num-to-poly 15125 5)) )))
(poly-string lex-rational-xyz (cadr (poly-gdiv lex-rational-xyz
(list (num-to-poly 15125 5) (num-to-poly 5125 5)) )))
(poly-string lex-rational-xyz (car (poly-gdiv lex-rational-xyz
(list (num-to-poly 15125 5) (num-to-poly 5125 5)) )))
;(x^3)+(3*x^4)+(x^5)
;(x^3)+(4*x^4)+(4*x^5)
;(1/4)
;(2*x^4)+(3/4*x^3)
;(4)
;(-8*x^4)+(-3*x^3)
;'done
;; redo previous tests on poly-gdiv
;; be careful with test cases, not to have duplicate monomials
(define do-test "no")
(define do-test "yes")
(if (equal? "yes" do-test) (print 'MAPLE_BEGIN))
(print "interface(prettyprint=0):interface(screenwidth=infinity):")
(print "interface(warnlevel=0):with(Groebner):")
(for-loop 0 (if (equal? "yes" do-test) numtests -1) (lambda (i)
(let* ((a (poly-prep rational-field (map (lambda (t) (cons (/ (car t) 19) (take 1 (cdr t))))
(list-ref test-polys (mod (square i) test-polys-len)))))
(b (poly-prep rational-field (map (lambda (t) (cons (/ (car t) 19) (take 1 (cdr t))))
(list-ref test-polys (mod (square i) test-polys-len)))))
(void (if (with-duplicate-monomials? a) (error (poly-list-string a))))
(void (if (with-duplicate-monomials? b) (error (poly-list-string b))))
(r1 (poly-add rational-field a b))
(r2 (poly-sub rational-field a b))
(r3 (poly-mul rational-field a b))
(r (car (poly-gdiv lex-rational-xyz (list a b))))
(q (cadr (poly-gdiv lex-rational-xyz (list a b))))
)
(print (string-append "i:=" (number->string i) ":"
"a:=" (poly-string lex-rational-xyz a) ":"
"b:=" (poly-string lex-rational-xyz b) ":"
"r1:=" (poly-string lex-rational-xyz r1) ":"
"r2:=" (poly-string lex-rational-xyz r2) ":"
"r3:=" (poly-string lex-rational-xyz r3) ":"
"q:=" (poly-string lex-rational-xyz q) ":"
"r:=" (poly-string lex-rational-xyz r) ":"
"if not simplify(expand(a+b)-r1)=0 then print(i,a,b,BUG1,expand(a+b),r1) fi:"
"if not simplify(expand(a-b)-r2)=0 then print(i,a,b,BUG2,expand(a-b),r2) fi:"
"if not simplify(expand(a*b)-r3)=0 then print(i,a,b,BUG3,expand(a*b),r3) fi:"
"if not simplify(expand(quo(a,b,x)-q))=0 then print(i,a,b,BUG4,quo(a,b,x),q) fi:"
"if not simplify(expand(rem(a,b,x)-r))=0 then print(i,a,b,BUG5,rem(a,b,x),r) fi:"
"if not simplify(b*q+r-a)=0 then print(BUG6) fi:"
))
)
))
(if (equal? "yes" do-test) (print 'MAPLE_END))
;'done
;; be careful with test cases, not to have duplicate monomials
(define do-test "no")
(define do-test "yes")
(if (equal? "yes" do-test) (print 'MAPLE_BEGIN))
(print "interface(prettyprint=0):interface(screenwidth=infinity):")
(print "interface(warnlevel=0):with(Groebner):")
(for-loop 0 (if (equal? "yes" do-test) numtests -1) (lambda (i)
(let* ((a (poly-prep rational-field (map (lambda (t) (cons (car t) (take 1 (cdr t))))
(list-ref test-polys (mod (square i) test-polys-len)))))
(b (poly-prep rational-field (map (lambda (t) (cons (car t) (take 1 (cdr t))))
(list-ref test-polys (mod (square i) test-polys-len)))))
(void (if (with-duplicate-monomials? a) (error (poly-list-string a))))
(void (if (with-duplicate-monomials? b) (error (poly-list-string b))))
(r1 (poly-add rational-field a b))
(r2 (poly-sub rational-field a b))
(r3 (poly-mul rational-field a b))
(r (car (poly-gdiv lex-rational-xyz (list a b))))
(q (cadr (poly-gdiv lex-rational-xyz (list a b))))
)
(print (string-append "i:=" (number->string i) ":"
"a:=" (poly-string lex-rational-xyz a) ":"
"b:=" (poly-string lex-rational-xyz b) ":"
"r1:=" (poly-string lex-rational-xyz r1) ":"
"r2:=" (poly-string lex-rational-xyz r2) ":"
"r3:=" (poly-string lex-rational-xyz r3) ":"
"q:=" (poly-string lex-rational-xyz q) ":"
"r:=" (poly-string lex-rational-xyz r) ":"
"if not simplify(expand(a+b)-r1)=0 then print(i,a,b,BUG1,expand(a+b),r1) fi:"
"if not simplify(expand(a-b)-r2)=0 then print(i,a,b,BUG2,expand(a-b),r2) fi:"
"if not simplify(expand(a*b)-r3)=0 then print(i,a,b,BUG3,expand(a*b),r3) fi:"
"if not simplify(expand(quo(a,b,x)-q))=0 then print(i,a,b,BUG4,quo(a,b,x),q) fi:"
"if not simplify(expand(rem(a,b,x)-r))=0 then print(i,a,b,BUG5,rem(a,b,x),r) fi:"
"if not simplify(b*q+r-a)=0 then print(BUG6) fi:"
))
)
))
(if (equal? "yes" do-test) (print 'MAPLE_END))
;'done
;; be careful with test cases, not to have duplicate monomials
(define do-test "no")
(define do-test "yes")
(if (equal? "yes" do-test) (print 'MAPLE_BEGIN))
(print "interface(prettyprint=0):interface(screenwidth=infinity):")
(print "interface(warnlevel=0):with(Groebner):")
(for-loop 0 (if (equal? "yes" do-test) numtests -1) (lambda (i)
(let* ((a (poly-prep Zp17 (map (lambda (t) (cons (car t) (take 1 (cdr t))))
(list-ref test-polys (mod (square i) test-polys-len)))))
(b (poly-prep Zp17 (map (lambda (t) (cons (car t) (take 1 (cdr t))))
(list-ref test-polys (mod (square i) test-polys-len)))))
(void (if (with-duplicate-monomials? a) (error (poly-list-string a))))
(void (if (with-duplicate-monomials? b) (error (poly-list-string b))))
(r1 (poly-add Zp17 a b))
(r2 (poly-sub Zp17 a b))
(r3 (poly-mul Zp17 a b))
(r (car (poly-gdiv lex-Zp17-xyz (list a b))))
(q (cadr (poly-gdiv lex-Zp17-xyz (list a b))))
)
(print (string-append "i:=" (number->string i) ":"
"a:=" (poly-string lex-Zp17-xyz a) ":"
"b:=" (poly-string lex-Zp17-xyz b) ":"
"r1:=" (poly-string lex-Zp17-xyz r1) ":"
"r2:=" (poly-string lex-Zp17-xyz r2) ":"
"r3:=" (poly-string lex-Zp17-xyz r3) ":"
"q:=" (poly-string lex-Zp17-xyz q) ":"
"r:=" (poly-string lex-Zp17-xyz r) ":"
"Q:=expand(Quo(a,b,x) mod 17):"
"R:=expand(Rem(a,b,x) mod 17):"
"R1:=expand(a+b) mod 17:"
"R2:=expand(a-b) mod 17:"
"R3:=expand(a*b) mod 17:"
"if not simplify(R1-r1)=0 then print(i,a,b,BUG1,R1,r1) fi:"
"if not simplify(R2-r2)=0 then print(i,a,b,BUG2,R2,r2) fi:"
"if not simplify(R3-r3)=0 then print(i,a,b,BUG3,R3,r3) fi:"
"if not simplify(Q-q)=0 then print(i,a,b,BUG4,Q,q) fi:"
"if not simplify(R-r)=0 then print(i,a,b,BUG5,R,r) fi:"
"if not (expand(b*q+r-a) mod 17)=0 then print(BUG6,expand(b*q+r-a) mod 17) fi:"
))
)
))
(if (equal? "yes" do-test) (print 'MAPLE_END))
;'done
;; be careful with test cases, not to have duplicate monomials
(define do-test "no")
(define do-test "yes")
(if (equal? "yes" do-test) (print 'MAPLE_BEGIN))
(print "interface(prettyprint=0):interface(screenwidth=infinity):")
(print "interface(warnlevel=0):with(Groebner):")
(for-loop 1 (if (equal? "yes" do-test) numtests 0) (lambda (i)
(for-loop 2 12 (lambda (j)
(let* (
(fG1 (map (lambda (p) (poly-prep rational-field p)) (take j test-polys)))
(fG2 (map (lambda (p) (poly-prep Zp17 p)) (take j test-polys)))
(rQ (poly-gdiv lex-rational-xyz fG1))
(r (car rQ))
(Q (cdr rQ))
)
(if (not (null? (poly-gdiv-verify lex-rational-xyz fG1))) (error "bug?"))
(if (not (null? (poly-gdiv-verify lex-Zp17-xyz fG2))) (error "bug?"))
(print (string-append "r:=" (poly-string lex-rational-xyz r) ":"
"f:=" (poly-string lex-rational-xyz (car fG1)) ":"
"G:=" (polys-string lex-rational-xyz (cdr fG1)) ":"
"s:=normalf(f,G,plex(x,y,z)):"
"if not (expand(s-r)=0) then print(BUG,s,r) fi:"
))
(set! test-polys (rotate-left-n j test-polys))
)
))))
(if (equal? "yes" do-test) (print 'MAPLE_END))
;'done
;; randomize a bit
(define do-test "no")
(define do-test "yes")
(if (equal? "yes" do-test) (print 'MAPLE_BEGIN))
(print "interface(prettyprint=0):interface(screenwidth=infinity):")
(print "interface(warnlevel=0):with(Groebner):")
(for-loop 1 (if (equal? "yes" do-test) numtests 0) (lambda (i)
(for-loop 2 6 (lambda (j)
(let* ((fG1 (map (lambda (p) (poly-prep rational-field p))
(map (lambda (k) (list-ref test-polys
(mod (square (* 16 k j i)) test-polys-len)))
(interval 1 j))
))
(r (normalf lex-rational-xyz fG1))
)
(print (string-append "r:=" (poly-string lex-rational-xyz r) ":"
"f:=" (poly-string lex-rational-xyz (car fG1)) ":"
"G:=" (polys-string lex-rational-xyz (cdr fG1)) ":"
"s:=normalf(f,G,plex(x,y,z)):"
"if not (expand(s-r)=0) then print(BUG,s,r) fi:"
))
(set! test-polys (rotate-left-n j test-polys))
)
))))
(if (equal? "yes" do-test) (print 'MAPLE_END))
;'done
(define f '((1 2 1)(1 1 2)(1 0 2)) )
(define fG (list f '((1 1 1)(-1 0 0)) '((1 0 2)(-1 0 0)) ) )
(poly-string lex-rational-xyz f)
(polys-string lex-rational-xyz fG)
(poly-gdiv lex-rational-xyz fG)
(poly-string lex-rational-xyz f)
(polys-string lex-rational-xyz fG)
;; check x y don't change
;(x^2*y)+(x*y^2)+(y^2)
;[(x^2*y)+(x*y^2)+(y^2),(x*y)+(-1),(y^2)+(-1)]
;(((1 1 0) (1 0 1) (1 0 0)) ((1 1 0) (1 0 1)) ((1 0 0)))
;(x^2*y)+(x*y^2)+(y^2)
;[(x^2*y)+(x*y^2)+(y^2),(x*y)+(-1),(y^2)+(-1)]
;'done
;; the point is, order in S makes a difference
(define f '( (1 1 2) (-1 1 0) ))
(define fG (list f '( (1 1 1) (1 0 0) ) '( (1 0 2) (-1 0 0) )))
(polys-string lex-rational-xyz (poly-gdiv lex-rational-xyz fG))
(define f '( (1 1 2) (-1 1 0) ))
(define fG (list f '( (1 0 2) (-1 0 0) ) '( (1 1 1) (1 0 0) ) ))
(polys-string lex-rational-xyz (poly-gdiv lex-rational-xyz fG))
;[(-1*y)+(-1*x),(y),0]
;[0,(x),0]
;'done
(define fG (list '() '( (1 0 2) (-1 0 0) ) '( (1 1 1) (1 0 0) ) ))
(polys-string lex-rational-xyz (poly-gdiv lex-rational-xyz fG))
;[0,0,0]
;'done
;; polynomial set monomial exponent gcd
(polys-mgcd (list '((1 3)(3 4)(1 5)) ))
(polys-mgcd (list '((1 3)(3 4)(1 5)) '((1 3)(4 4)(4 5)) ))
(polys-mgcd (list '((1 2)(3 3)(1 4)) '((1 3)(4 4)(4 5)) ))
;(3)
;(3)
;(2)
(polys-mgcd (list '((1 3 2)(3 4 6)(1 5 2)) ))
(polys-mgcd (list '((1 3 3)(3 4 5)(1 5 1)) '((1 3 4)(4 4 3)(4 5 0)) ))
(polys-mgcd (list '((1 2 3)(3 3 4)(1 4 6)) '((1 3 4)(4 4 2)(4 5 4)) ))
;(3 2)
;(3 0)
;(2 2)
;'done
(map (take-out-mgcd '(3 2)) (list '((1 3 2)(3 4 6)(1 5 2)) ))
(map (take-out-mgcd '(3 0)) (list '((1 3 3)(3 4 5)(1 5 1)) '((1 3 4)(4 4 3)(4 5 0)) ))
(map (take-out-mgcd '(2 2)) (list '((1 2 3)(3 3 4)(1 4 6)) '((1 3 4)(4 4 2)(4 5 4)) ))
;(((1 0 0) (3 1 4) (1 2 0)))
;(((1 0 3) (3 1 5) (1 2 1)) ((1 0 4) (4 1 3) (4 2 0)))
;(((1 0 1) (3 1 2) (1 2 4)) ((1 1 2) (4 2 0) (4 3 2)))
(map (put-back-mgcd '(3 2)) '(((1 0 0) (3 1 4) (1 2 0))) )
(map (put-back-mgcd '(3 0)) '(((1 0 3) (3 1 5) (1 2 1)) ((1 0 4) (4 1 3) (4 2 0))) )
(map (put-back-mgcd '(2 2)) '(((1 0 1) (3 1 2) (1 2 4)) ((1 1 2) (4 2 0) (4 3 2))) )
;(((1 3 2) (3 4 6) (1 5 2)))
;(((1 3 3) (3 4 5) (1 5 1)) ((1 3 4) (4 4 3) (4 5 0)))
;(((1 2 3) (3 3 4) (1 4 6)) ((1 3 4) (4 4 2) (4 5 4)))
;'done
(poly-scale rational-field 3 '((1 1 2 3)(2 1 2 3)))
;((3 1 2 3) (6 1 2 3))
;'done
;; only use this on rational polynomials
;; mainly used for testing with Maple's gbasis and gcd
(polys-make-integer (list '((1/2 0 0) (1/3 1 4) (1/5 2 0)) ))
(polys-make-integer (list '((1/2 0 0) (1/3 1 4) (1/5 2 0))
'((1/7 0 0) (1/11 1 4) (1/13 2 0)) ))
(polys-make-integer (list '((3/2 0 0) (1/2 1 4) (3/6 2 0)) ))
(polys-make-integer (list '((1 0 0) (2/3 1 4) (2/6 2 0)) ))
;(((15 0 0) (10 1 4) (6 2 0)))
;(((15015 0 0) (10010 1 4) (6006 2 0)) ((4290 0 0) (2730 1 4) (2310 2 0)))
;(((3 0 0) (1 1 4) (1 2 0)))
;(((3 0 0) (2 1 4) (1 2 0)))
;'done
(poly-string lex-rational-xyz '((1 2 1) (2 1 2)))
(poly-string lex-rational-xyz '((3 0 2) (2 0 0)))
(poly-string lex-rational-xyz (s-poly lex-rational-xyz '((1 2 1) (2 1 2)) '((3 0 2) (2 0 0)) ))
;(x^2*y)+(2*x*y^2)
;(3*y^2)+(2)
;(6*x*y^3)+(-2*x^2)
;'done
(poly-string lex-rational-xyz '((1 1 2 1) (-1 1 1 1)))
(poly-string lex-rational-xyz '((1 2 1 1) (-1 0 0 2)))
(poly-string lex-rational-xyz (s-poly lex-rational-xyz '((1 1 2 1) (-1 1 1 1))
'((1 2 1 1) (-1 0 0 2)) ))
;(x*y^2*z)+(-1*x*y*z)
;(x^2*y*z)+(-1*z^2)
;(-1*x^2*y*z)+(y*z^2)
;'done
(poly-string lex-rational-xyz '((1 1 0 0) (-13 0 2 0) (-12 0 0 3)))
(poly-string lex-rational-xyz '((1 2 0 0) (-1 1 1 0) (92 0 0 1) ))
(poly-string lex-rational-xyz (s-poly lex-rational-xyz '((1 1 0 0) (-13 0 2 0) (-12 0 0 3))
'((1 2 0 0) (-1 1 1 0) (92 0 0 1)) ))
;(x)+(-13*y^2)+(-12*z^3)
;(x^2)+(-1*x*y)+(92*z)
;(-12*x*z^3)+(-13*x*y^2)+(x*y)+(-92*z)
;'done
;;
;; Three examples:
;; 1. LT(f1) and LT(f2) are relatively prime and LC(f1)=LC(f2)=1
;; => LM(S-poly(f1,f2)) is a multiple of LM(f1) or LM(f2) <= so what?
(poly-string lex-rational-xyz '((1 1 1 0) (1 0 0 3)))
(poly-string lex-rational-xyz '((1 0 0 2) (-3 0 0 1)))
(poly-string lex-rational-xyz (s-poly lex-rational-xyz '((1 1 1 0) (1 0 0 3))
'((1 0 0 2) (-3 0 0 1)) ))
(term-string lex-rational-xyz (LT lex-rational-xyz '((1 1 1 0) (1 0 0 3)) ))
(term-string lex-rational-xyz (LT lex-rational-xyz '((1 0 0 2) (-3 0 0 1)) ))
(term-string lex-rational-xyz (LT lex-rational-xyz
(s-poly lex-rational-xyz '((1 1 1 0) (1 0 0 3))
'((1 0 0 2) (-3 0 0 1)) )))
;(x*y)+(z^3)
;(z^2)+(-3*z)
;(z^5)+(3*x*y*z)
;(x*y)
;(z^2)
;(3*x*y*z)
;'done
(newline)
(poly-string lex-rational-xyz '((4 2 0 1) (-7 0 2 0)) )
(poly-string lex-rational-xyz '((1 1 1 2) (3 1 0 4)) )
(poly-string lex-rational-xyz (s-poly lex-rational-xyz '((4 2 0 1) (-7 0 2 0))
'((1 1 1 2) (3 1 0 4)) ))
;(4*x^2*z)+(-7*y^2)
;(x*y*z^2)+(3*x*z^4)
;(-7*y^3*z)+(-12*x^2*z^4)
;'done
(newline)
(poly-string lex-rational-xyz '((1 4 1 0) (-1 0 0 2)) )
(poly-string lex-rational-xyz '((3 1 0 2) (-1 0 1 0)) )
(poly-string lex-rational-xyz (s-poly lex-rational-xyz '((1 4 1 0) (-1 0 0 2))
'((3 1 0 2) (-1 0 1 0)) ))
;(x^4*y)+(-1*z^2)
;(3*x*z^2)+(-1*y)
;(-3*z^4)+(x^3*y^2)
;'done
(newline)
(define p1 '((1 0 1 0) (-1 0 0 2)) )
(define p2 '((1 1 0 0) (-1 0 0 3)) )
(poly-string (lex-rational '("z" "y" "x")) p1)
(poly-string (lex-rational '("z" "y" "x")) p2)
(poly-string (lex-rational '("z" "y" "x")) (s-poly (lex-rational '("z" "y" "x")) p1 p2))
(poly-string (lex-rational '("z" "y" "x")) (s-poly (lex-rational '("z" "y" "x")) p2 p1))
;(y)+(-1*x^2)
;(z)+(-1*x^3)
;(-1*z*x^2)+(y*x^3)
;(-1*y*x^3)+(z*x^2)
;; seems to differ by sign only
;'done
(newline)
(define p1 '((1 0 1 0) (-1 0 0 2)) )
(define p2 '((1 1 0 0) (-1 0 0 3)) )
(define s (s-poly (lex-rational '("z" "y" "x")) p1 p2))
(define rQ (poly-gdiv (lex-rational '("z" "y" "x")) (list s p1 p2)))
(poly-string (lex-rational '("z" "y" "x")) (car rQ))
(polys-string (lex-rational '("z" "y" "x")) (cdr rQ))
;0
;[(x^3),(-1*x^2)]
;'done
(newline)
(define p1 '((1 0 1 0) (-1 0 0 2)) )
(define p2 '((1 1 0 0) (-1 0 0 3)) )
(grobner? lex-rational-xyz (list p1 p2))
(grobner? lex-rational-xyz (list p2 p1))
;#t
;#t
;'done
;; generate indices set for n elements
(newline)
(gen-indices-set 5)
;((0 . 1) (0 . 2) (0 . 3) (0 . 4) (1 . 2) (1 . 3) (1 . 4) (2 . 3) (2 . 4) (3 . 4))
;'done
;; has the side-effect of sorting the polynomial (because of LC)
(newline)
(poly-make-monic lex-rational-xyz '((2 1 2 3)(5 2 3 4)))
;((1 2 3 4) (2/5 1 2 3))
;'done
(newline)
(permu '(0 1 2))
(length (permu '(0 1 2)))
;((0 0 0) (0 0 1) (0 0 2) (0 1 0) (0 1 1) (0 1 2))
;6
'done
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; grobner basis is completely broken beyond repair!
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; (randomly-pick-n n lst)
(newline)
(polys-string lex-rational-xyz (randomly-pick-n 1 test-polys))
(polys-string lex-rational-xyz (randomly-pick-n 2 test-polys))
(polys-string lex-rational-xyz (randomly-pick-n 3 test-polys))
;'done
(newline)
(constant-poly? '((1)))
(constant-poly? '((1 0)))
(constant-poly? '((1 0 0)))
(constant-poly? '((2)))
(constant-poly? '((2 0)))
(constant-poly? '((2 0 0)))
(constant-poly? '((3)))
(constant-poly? '((3 1)))
(constant-poly? '((3 2 3)))
;'done
(newline)
(print 'MAPLE_BEGIN)
(print "############################################################################")
(print "interface(prettyprint=0):interface(screenwidth=infinity):")
(print "interface(warnlevel=0):with(Groebner):")
(for-each (lambda (i)
(define S (randomly-pick-n 4 test-polys))
(define S1 (list-copy S))
(define S2 (list-copy S))
(define g1 (ngbasis lex-rational-xyz S1))
(define g2 (gbasis lex-rational-xyz S2))
(if (not (equal? g1 g2))
(begin (print "error")
(print (polys-string lex-rational-xyz S))
(print (polys-string lex-rational-xyz S1))
(print (polys-string lex-rational-xyz S2))
(print (polys-string lex-rational-xyz g1))
(print (polys-string lex-rational-xyz g2))
(print (string-append "S:=" (polys-string grevlex-rational-xyz S) ":"
"gb:=convert(gbasis(S,tdeg(x,y,z)),set):"
"print(S);print(gb);"
))
)
(if (null? g1)
(begin (print "error?")
(print (polys-string lex-rational-xyz S))
(print (polys-string lex-rational-xyz S1))
(print (polys-string lex-rational-xyz S2))
(print (polys-string lex-rational-xyz g1))
(print (polys-string lex-rational-xyz g2))
(print (string-append "S:=" (polys-string grevlex-rational-xyz S) ":"
"gb:=convert(gbasis(S,tdeg(x,y,z)),set):"
"print(S);print(gb);"
))
)
(begin
(print (string-append "S:=" (polys-string grevlex-rational-xyz S) ":"
"gb:=convert(gbasis(S,tdeg(x,y,z)),set):"
"mygb:=convert(" (polys-string grevlex-rational-xyz
(map (lambda (p) (poly-make-integer grevlex-rational-xyz p)) g1) ) ",set):"
"mygb2:=convert(" (polys-string lex-rational-xyz g1) ",set):"
"if not (((gb minus mygb)={}) or ((gb minus mygb2)={})) "
"then print(S);print(gb);print(mygb);print(mygb2);print(gb minus mygb);print(gb minus mygb2) fi:"
))
)
)
)
) (interval 1 1))
(print "############################################################################")
(print 'MAPLE_END)
'done
;; inconsistent system
(define S (list '((4 0 0 0)) '((3 0 0 0)) '((2 0 0 0)) ))
(polys-string lex-rational-xyz S)
(define G (buchberger lex-rational-xyz S))
(define RG (g-reduce lex-rational-xyz G))
(define GB (gbasis lex-rational-xyz S))
(if (not (grobner? lex-rational-xyz G)) (error "bug001?"))
(if (not (grobner? lex-rational-xyz RG)) (error "bug002?"))
(if (not (grobner? lex-rational-xyz GB)) (error "bug003?"))
(polys-string lex-rational-xyz GB)
(print (string-append "G:=convert(gbasis("
(polys-string lex-rational-xyz S) ",plex(x,y,z)),set):"
"myG:=convert(" (polys-string lex-rational-xyz GB) ",set):G minus myG;"
))
(polys-string lex-rational-xyz S)
;[(4),(3),(2)]
;[(1)]
;[(4),(3),(2)]
;'done
;; gcd <> 0
(define S (list
'((29 10 6 2)(29 10 6 4)(29 10 8 2)(29 10 8 4)(29 12 6 2)(29 12 6 4)(29 12 8 2)(29 12 8 4))
'((30 10 6 2)(30 10 6 4)(30 10 8 2)(30 10 8 4)(30 12 6 2)(30 12 6 4)(30 12 8 2)(30 12 8 4)) ))
(polys-string lex-rational-xyz S)
(define G (buchberger lex-rational-xyz S))
(define RG (g-reduce lex-rational-xyz G))
(define GB (gbasis lex-rational-xyz S))
(if (not (grobner? lex-rational-xyz G)) (error "bug?"))
(if (not (grobner? lex-rational-xyz RG)) (error "bug?"))
(if (not (grobner? lex-rational-xyz GB)) (error "bug?"))
(polys-string lex-rational-xyz GB)
(print (string-append "G:=convert(gbasis("
(polys-string lex-rational-xyz S) ",plex(x,y,z)),set):"
"myG:=convert(" (polys-string lex-rational-xyz GB) ",set):G minus myG;"
"simplify(myG[1]-gcd(" (poly-string lex-rational-xyz (car S)) ","
(poly-string lex-rational-xyz (cadr S)) "));"
))
;'done
;; duplicate polynomials
(define S (list
'((29 10 6 2)(29 10 6 4)(29 10 8 2)(29 10 8 4)(29 12 6 2)(29 12 6 4)(29 12 8 2)(29 12 8 4))
'((30 10 6 2)(30 10 6 4)(30 10 8 2)(30 10 8 4)(30 12 6 2)(30 12 6 4)(30 12 8 2)(30 12 8 4))
'((29 10 6 2)(29 10 6 4)(29 10 8 2)(29 10 8 4)(29 12 6 2)(29 12 6 4)(29 12 8 2)(29 12 8 4))
'((30 10 6 2)(30 10 6 4)(30 10 8 2)(30 10 8 4)(30 12 6 2)(30 12 6 4)(30 12 8 2)(30 12 8 4))
'((29 10 6 2)(29 10 6 4)(29 10 8 2)(29 10 8 4)(29 12 6 2)(29 12 6 4)(29 12 8 2)(29 12 8 4))
'((30 10 6 2)(30 10 6 4)(30 10 8 2)(30 10 8 4)(30 12 6 2)(30 12 6 4)(30 12 8 2)(30 12 8 4))
))
(polys-string lex-rational-xyz S)
(define G (buchberger lex-rational-xyz S))
(define RG (g-reduce lex-rational-xyz G))
(define GB (gbasis lex-rational-xyz S))
(if (not (grobner? lex-rational-xyz G)) (error "bug?"))
(if (not (grobner? lex-rational-xyz RG)) (error "bug?"))
(if (not (grobner? lex-rational-xyz GB)) (error "bug?"))
(polys-string lex-rational-xyz GB)
(print (string-append "G:=convert(gbasis("
(polys-string lex-rational-xyz S) ",plex(x,y,z)),set):"
"myG:=convert(" (polys-string lex-rational-xyz GB) ",set):G minus myG;"
"simplify(myG[1]-gcd(" (poly-string lex-rational-xyz (car S)) ","
(poly-string lex-rational-xyz (cadr S)) "));"
))
;'done
(define S (list '((4 2 0 1) (-7 0 2 0)) '((1 1 1 2) (3 1 0 4)) ) )
(polys-string lex-rational-xyz S)
(define G (buchberger lex-rational-xyz S))
(define RG (g-reduce lex-rational-xyz G))
(define GB (gbasis lex-rational-xyz S))
(if (not (grobner? lex-rational-xyz G)) (error "bug?"))
(if (not (grobner? lex-rational-xyz RG)) (error "bug?"))
(if (not (grobner? lex-rational-xyz GB)) (error "bug?"))
(polys-string lex-rational-xyz GB)
(print (string-append "G:=convert(gbasis("
(polys-string lex-rational-xyz S) ",plex(x,y,z)),set):"
"myG:=convert(" (polys-string lex-rational-xyz
(map (lambda (p) (poly-make-integer lex-rational-xyz p)) GB) )
",set):G minus myG;"
))
;[(x*y*z^2)+(3*x*z^4),(x^2*z)+(-7/4*y^2),(y^3*z)+(3*y^2*z^3),(y^5)+(27*y^2*z^6)]
;'done
(define S (list '((1 2 0 1)(-1 0 2 0))
'((1 0 1 2)(1 0 0 1))
'((1 0 1 0)(-1 0 0 1)) ))
(polys-string lex-rational-xyz S)
(define G (buchberger lex-rational-xyz S))
(define RG (g-reduce lex-rational-xyz G))
(define GB (gbasis lex-rational-xyz S))
(if (not (grobner? lex-rational-xyz G)) (error "bug?"))
(if (not (grobner? lex-rational-xyz RG)) (error "bug?"))
(if (not (grobner? lex-rational-xyz GB)) (error "bug?"))
(polys-string lex-rational-xyz GB)
(print (string-append "G:=convert(gbasis("
(polys-string lex-rational-xyz S) ",plex(x,y,z)),set):"
"myG:=convert(" (polys-string lex-rational-xyz
(map (lambda (p) (poly-make-integer lex-rational-xyz p)) GB) )
",set):G minus myG;"
))
;[(x^2*z)+(-1*y^2),(y*z^2)+(z),(y)+(-1*z)]
;[(y)+(-1*z),(x^2*z)+(-1*z^2),(z^3)+(z)]
;'done
(define S (list '((1 2 0 0)(1 0 2 0)(1 0 0 2)(-1 0 0 0))
'((1 2 0 0)(1 0 2 0)(1 0 0 2)(-2 1 0 0))
'((2 1 0 0)(-3 0 1 0)(-1 0 0 1)) ))
(polys-string lex-rational-xyz S)
(define G (buchberger lex-rational-xyz S))
(define RG (g-reduce lex-rational-xyz G))
(define GB (gbasis lex-rational-xyz S))
(if (not (grobner? lex-rational-xyz G)) (error "bug?"))
(if (not (grobner? lex-rational-xyz RG)) (error "bug?"))
(if (not (grobner? lex-rational-xyz GB)) (error "bug?"))
(polys-string lex-rational-xyz GB)
(print (string-append "G:=convert(gbasis("
(polys-string lex-rational-xyz S) ",plex(x,y,z)),set):"
"myG:=convert(" (polys-string lex-rational-xyz
(map (lambda (p) (poly-make-integer lex-rational-xyz p)) GB) )
",set):G minus myG;"
))
;[(x^2)+(y^2)+(z^2)+(-1),(x^2)+(y^2)+(z^2)+(-2*x),(2*x)+(-3*y)+(-1*z)]
;[(z^2)+(-1/5*z)+(-23/40),(y)+(1/3*z)+(-1/3),(x)+(-1/2)]
;'done
(define S (list '((1 2 0 0)(1 0 0 2)(1 0 2 0)(-1 0 0 0))
'((1 2 0 0)(1 0 0 2)(1 0 2 0)(-2 1 0 0))
'((2 1 0 0)(-3 0 0 1)(-1 0 1 0)) ))
(polys-string lex-rational-xyz S)
(define G (buchberger lex-rational-xyz S))
(define RG (g-reduce lex-rational-xyz G))
(define GB (gbasis lex-rational-xyz S))
(if (not (grobner? lex-rational-xyz G)) (error "bug?"))
(if (not (grobner? lex-rational-xyz RG)) (error "bug?"))
(if (not (grobner? lex-rational-xyz GB)) (error "bug?"))
(polys-string lex-rational-xyz GB)
(print (string-append "G:=convert(gbasis("
(polys-string lex-rational-xyz S) ",plex(x,y,z)),set):"
"myG:=convert(" (polys-string lex-rational-xyz
(map (lambda (p) (poly-make-integer lex-rational-xyz p)) GB) )
",set):G minus myG;"
))
;[(x^2)+(z^2)+(y^2)+(-1),(x^2)+(z^2)+(y^2)+(-2*x),(2*x)+(-3*z)+(-1*y)]
;[(x)+(-1/2),(y)+(3*z)+(-1),(z^2)+(-3/5*z)+(1/40)]
;'done
;; http://www.orcca.on.ca/~raqeeb/Publications/grobner_examples.html
(define S (list '((1 0 1 2)(1 0 0 0)) '((1 2 0 0)(-1 0 0 2)) '((1 1 2 0)(1 0 0 0)) ))
(polys-string lex-rational-xyz S)
(define G (buchberger lex-rational-xyz S))
(define RG (g-reduce lex-rational-xyz G))
(define GB (gbasis lex-rational-xyz S))
(if (not (grobner? lex-rational-xyz G)) (error "bug?"))
(if (not (grobner? lex-rational-xyz RG)) (error "bug?"))
(if (not (grobner? lex-rational-xyz GB)) (error "bug?"))
(polys-string lex-rational-xyz GB)
(print (string-append "G:=convert(gbasis("
(polys-string lex-rational-xyz S) ",plex(x,y,z)),set):"
"myG:=convert(" (polys-string lex-rational-xyz
(map (lambda (p) (poly-make-integer lex-rational-xyz p)) GB) )
",set):G minus myG;"
))
;[(y*z^2)+(1),(x^2)+(-1*z^2),(x*y^2)+(1)]
;[(x)+(z^4),(y)+(z^4),(z^6)+(-1)]
;'done
(define S (list '((1 2 0)(2 1 2)) '((1 1 1)(2 0 3)(-1 0 0)) ))
(polys-string lex-rational-xyz S)
(define G (buchberger lex-rational-xyz S))
(define RG (g-reduce lex-rational-xyz G))
(define GB (gbasis lex-rational-xyz S))
(if (not (grobner? lex-rational-xyz G)) (error "bug?"))
(if (not (grobner? lex-rational-xyz RG)) (error "bug?"))
(if (not (grobner? lex-rational-xyz GB)) (error "bug?"))
(polys-string lex-rational-xyz GB)
(print (string-append "G:=convert(gbasis("
(polys-string lex-rational-xyz S) ",plex(x,y,z)),set):"
"myG:=convert(" (polys-string lex-rational-xyz
(map (lambda (p) (poly-make-integer lex-rational-xyz p)) GB) )
",set):G minus myG;"
))
;[(x^2)+(2*x*y^2),(x*y)+(2*y^3)+(-1)]
;[(x),(y^3)+(-1/2)]
;'done
(define S (list '((1 2 0 0 0)(1 0 2 0 0)(1 0 0 2 0)(1 0 0 0 2))
'((1 2 0 0 0)(2 0 2 0 0)(-1 0 1 1 0)(-1 0 0 0 2))
'((1 1 0 0 0)(1 0 0 3 0)(-1 0 0 0 3)) ))
(polys-string (lex-rational '("t" "x" "y" "z")) S)
(define G (buchberger (lex-rational '("t" "x" "y" "z")) S))
(define RG (g-reduce (lex-rational '("t" "x" "y" "z")) G))
(define GB (gbasis (lex-rational '("t" "x" "y" "z")) S))
(if (not (grobner? (lex-rational '("t" "x" "y" "z")) G)) (error "bug?"))
(if (not (grobner? (lex-rational '("t" "x" "y" "z")) RG)) (error "bug?"))
(if (not (grobner? (lex-rational '("t" "x" "y" "z")) GB)) (error "bug?"))
(polys-string (lex-rational '("t" "x" "y" "z")) GB)
(print (string-append "G:=convert(gbasis("
(polys-string (lex-rational '("t" "x" "y" "z")) S) ",plex(t,x,y,z)),set):"
"myG:=convert(" (polys-string (lex-rational '("t" "x" "y" "z"))
(map (lambda (p) (poly-make-integer (lex-rational '("t" "x" "y" "z")) p)) GB) )
",set):G minus myG;"
))
;[(t^2)+(x^2)+(y^2)+(z^2),(t^2)+(2*x^2)+(-1*x*y)+(-1*z^2),(t)+(y^3)+(-1*z^3)]
;'done
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; the following takes too long
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; inconsistent system
(newline)
(define S (list '((1 2 1 0)(-1 0 0 3)) '((2 1 1 0)(-4 0 0 1)(-1 0 0 0))
'((1 0 0 1)(-1 0 2 0)) '((1 3 0 0)(-4 0 1 1)) ))
(polys-string lex-rational-xyz S)
(define G (buchberger lex-rational-xyz S))
(define RG (g-reduce lex-rational-xyz G))
(define GB (gbasis lex-rational-xyz S))
(if (not (grobner? lex-rational-xyz G)) (error "bug?"))
(if (not (grobner? lex-rational-xyz RG)) (error "bug?"))
(if (not (grobner? lex-rational-xyz GB)) (error "bug?"))
(polys-string lex-rational-xyz GB)
(print (string-append "G:=convert(gbasis("
(polys-string lex-rational-xyz S) ",plex(x,y,z)),set):"
"myG:=convert(" (polys-string lex-rational-xyz
(map (lambda (p) (poly-make-integer lex-rational-xyz p)) GB) )
",set):G minus myG;"
))
;[(x^2*y)+(-1*z^3),(2*x*y)+(-4*z)+(-1),(z)+(-1*y^2),(x^3)+(-4*y*z)]
;[(1)]
;'done
;; multiply inconsistent system by some term
(newline)
(define w '((1 2 1 0)(-1 0 0 3))) (set! w (TmulP rational-field '(1 1 1 1) w))
(define x '((2 1 1 0)(-4 0 0 1)(-1 0 0 0))) (set! x (TmulP rational-field '(1 1 1 1) x))
(define y '((1 0 0 1)(-1 0 2 0))) (set! y (TmulP rational-field '(1 1 1 1) y))
(define z '((1 3 0 0)(-4 0 1 1))) (set! z (TmulP rational-field '(1 1 1 1) z))
(define S (list w x y z))
(polys-string lex-rational-xyz S)
(define G (buchberger lex-rational-xyz S))
(define RG (g-reduce lex-rational-xyz G))
(define GB (gbasis lex-rational-xyz S))
(if (not (grobner? lex-rational-xyz G)) (error "bug?"))
(if (not (grobner? lex-rational-xyz RG)) (error "bug?"))
(if (not (grobner? lex-rational-xyz GB)) (error "bug?"))
(polys-string lex-rational-xyz GB)
(print (string-append "G:=convert(gbasis("
(polys-string lex-rational-xyz S) ",plex(x,y,z)),set):"
"myG:=convert(" (polys-string lex-rational-xyz
(map (lambda (p) (poly-make-integer lex-rational-xyz p)) GB) )
",set):G minus myG;"
))
;[(x*y*z)]
;'done
;; add some term to inconsistent system
(newline)
(define w '((1 2 1 0)(-1 0 0 3))) (set! w (TaddP rational-field '(1 1 1 1) w))
(define x '((2 1 1 0)(-4 0 0 1)(-1 0 0 0))) (set! x (TaddP rational-field '(1 1 1 1) x))
(define y '((1 0 0 1)(-1 0 2 0))) (set! y (TaddP rational-field '(1 1 1 1) y))
(define z '((1 3 0 0)(-4 0 1 1))) (set! z (TaddP rational-field '(1 1 1 1) z))
(define S (list w x y z))
(polys-string lex-rational-xyz S)
(define G (buchberger lex-rational-xyz S))
(define RG (g-reduce lex-rational-xyz G))
(define GB (gbasis lex-rational-xyz S))
(if (not (grobner? lex-rational-xyz G)) (error "bug?"))
(if (not (grobner? lex-rational-xyz RG)) (error "bug?"))
(if (not (grobner? lex-rational-xyz GB)) (error "bug?"))
(polys-string lex-rational-xyz GB)
(print (string-append "G:=convert(gbasis("
(polys-string lex-rational-xyz S) ",plex(x,y,z)),set):"
"myG:=convert(" (polys-string lex-rational-xyz
(map (lambda (p) (poly-make-integer lex-rational-xyz p)) GB) )
",set):G minus myG;"
))
;[(1)]
;'done
;; takes too long
(newline)
(define S '( ((1 1 0 0)(1 0 1 0)(1 0 0 1)(-6 0 0 0))
((1 2 0 0)(1 0 2 0)(1 0 0 2)(-14 0 0 0))
((1 3 0 0)(1 0 3 0)(1 0 0 3)(-36 0 0 0))
))
(polys-string lex-rational-xyz S)
(define GB (gbasis lex-rational-xyz S))
(if (not (grobner? lex-rational-xyz GB)) (error "bug?"))
(polys-string lex-rational-xyz GB)
(print (string-append "G:=convert(gbasis("
(polys-string lex-rational-xyz S) ",plex(x,y,z)),set):"
"myG:=convert(" (polys-string lex-rational-xyz
(map (lambda (p) (poly-make-integer lex-rational-xyz p)) GB) )
",set):G minus myG;"
))
;[(x)+(y)+(z)+(-6),(x^2)+(y^2)+(z^2)+(-14),(x^3)+(y^3)+(z^3)+(-36)]
;[(z^3)+(-6*z^2)+(11*z)+(-6),(y^2)+(y*z)+(-6*y)+(z^2)+(-6*z)+(11),(x)+(y)+(z)+(-6)]
;'done
(newline)
(define do-test "no")
(define do-test "yes")
(if (equal? "yes" do-test) (print 'MAPLE_BEGIN))
(print "interface(prettyprint=0):interface(screenwidth=infinity):")
(print "interface(warnlevel=0):with(Groebner):")
(set! test-polys (rotate-right test-polys))
(for-loop 1 (if (equal? "yes" do-test) numtests 0) (lambda (i)
(for-loop 2 16 (lambda (j) ;; j=1 single polynomial causes grief
(let* ((S (map (lambda (p) (poly-prep rational-field p)) (take j test-polys)))
(GB (gbasis lex-rational-xyz S))
)
(print (string-append "S:=" (polys-string lex-rational-xyz S) ":"
"gb:=convert(gbasis(S,plex(x,y,z)),set):"
"mygb:=convert(" (polys-string lex-rational-xyz
(map (lambda (p) (poly-make-integer lex-rational-xyz p)) GB) ) ",set):"
"mygb2:=convert(" (polys-string lex-rational-xyz GB) ",set):"
"i:=" (number->string i) ":j:=" (number->string j) ":"
"if not (((gb minus mygb)={}) or ((gb minus mygb2)={})) "
"then print(BUG,S,gb,mygb,mygb2,gb minus mygb,gb minus mygb2,i,j) fi:"
))
(set! test-polys (rotate-left test-polys))
)
))))
(if (equal? "yes" do-test) (print 'MAPLE_END))
;'done
; cat /tmp/maple.txt | maple -q
;; randomize a bit
(newline)
(define do-test "no")
(define do-test "yes")
(if (equal? "yes" do-test) (print 'MAPLE_BEGIN))
(print "interface(prettyprint=0):interface(screenwidth=infinity):")
(print "interface(warnlevel=0):with(Groebner):")
(set! test-polys (rotate-right test-polys))
(for-loop 1 (if (equal? "yes" do-test) numtests 0) (lambda (i)
(for-loop 2 6 (lambda (j)
(let* ((S (map (lambda (p) (poly-prep rational-field p))
(map (lambda (k) (list-ref test-polys (mod (square (* 2 k j i)) test-polys-len)))
(interval 1 j))
))
(GB (gbasis grevlex-rational-xyz S))
)
(print (string-append "S:=" (polys-string grevlex-rational-xyz S) ":"
"gb:=convert(gbasis(S,tdeg(x,y,z)),set):"
"mygb:=convert(" (polys-string grevlex-rational-xyz
(map (lambda (p) (poly-make-integer grevlex-rational-xyz p)) GB) ) ",set):"
"mygb2:=convert(" (polys-string lex-rational-xyz GB) ",set):"
"i:=" (number->string i) ":j:=" (number->string j) ":"
"if not (((gb minus mygb)={}) or ((gb minus mygb2)={})) "
"then print(BUG,S,gb,mygb,mygb2,gb minus mygb,gb minus mygb2,i,j) fi:"
))
(set! test-polys (rotate-left test-polys))
)
))))
(if (equal? "yes" do-test) (print 'MAPLE_END))
;'done
; cat /tmp/maple.txt | maple -q
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; you may turn off test-polys from above
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; hard problem
(newline)
(define S '(
((29 11 7 4)(29 11 7 2)(29 11 5 4)(29 11 5 2)(29 10 7 4)(29 10 7 2)(29 10 5 4)(29 10 5 2))
((29 12 8 3)(29 12 8 1)(29 12 5 3)(29 12 5 1)(29 9 8 3)(29 9 8 1)(29 9 5 3)(29 9 5 1))
((29 7 11 4)(29 7 11 2)(29 7 10 4)(29 7 10 2)(29 6 11 4)(29 6 11 2)(29 6 10 4)(29 6 10 2))
((29 7 4 12)(29 7 4 9)(29 7 1 12)(29 7 1 9)(29 5 4 12)(29 5 4 9)(29 5 1 12)(29 5 1 9))
((29 3 7 11)(29 3 7 10)(29 3 6 11)(29 3 6 10)(29 1 7 11)(29 1 7 10)(29 1 6 11)(29 1 6 10))
((21 8 16 3)(21 8 16 2)(21 8 13 3)(21 8 13 2)(21 5 16 3)(21 5 16 2)(21 5 13 3)(21 5 13 2))
))
(polys-string lex-rational-xyz S)
(define GB (gbasis lex-rational-xyz S))
(grobner? lex-rational-xyz GB)
(polys-string lex-rational-xyz GB)
(print (string-append "G:=convert(gbasis("
(polys-string lex-rational-xyz S) ",plex(x,y,z)),set):"
"myG:=convert(" (polys-string lex-rational-xyz
(map (lambda (p) (poly-make-integer lex-rational-xyz p)) GB) )
",set):G minus myG;"
))
;'done
;(length S) (length GB)
;(polys-big-small lex-rational-xyz S)
;(polys-big-small lex-rational-xyz GB)
;6 13
;((29 12 8 3) (29 1 6 10))
;((1 12 8 1) (-1/2 1 6 10))
; with(Groebner);
; result checked with maple
;; hard problem?
(newline)
(define GB (gbasis grevlex-rational-xyz S))
(grobner? grevlex-rational-xyz GB)
(polys-string grevlex-rational-xyz GB)
(print (string-append "G:=convert(gbasis("
(polys-string grevlex-rational-xyz S) ",tdeg(x,y,z)),set):"
"myG:=convert(" (polys-string grevlex-rational-xyz
(map (lambda (p) (poly-make-integer grevlex-rational-xyz p)) GB) )
",set):G minus myG;"
))
'done
; with(Groebner);
; result checked with maple
;
; you can take sin and cos of complex number. complex^complex too.
;
; z = r (cos x + i sin x) = r exp(i x)
;
;
; http://mathforum.org/library/drmath/view/52251.html
; Any real number a can be written as e^ln(a); so ; a-exp(ln(a)); => 0
; a^(ix) = (e^ln(a))^(ix)
; = e^(ix*ln(a)) ; (b^5)^3-(b)^(5*3); => 0
; = cos(x*ln(a)) + i*sin(x*ln(a))
; We can extend this to complex exponents this way:
; a^(x+iy) = a^x * a^(iy)
; To allow for complex bases, write the base in the form a*e^(ib), and you find
; [a*e^(ib)]^z = a^z * e^(ib*z)
;
;
; let z=(x+iy)
; zeta(z)=sum[1<=n<inf] ( 1/n^z ) = ... ( n^-z ) = ... ( n^(-x-iy) ) = ... ( n^-x * n^-iy )
; = ... ( n^-x * ( cos(-y*ln(n)) + i*sin(-y*ln(n)) ) ) = 0
; then all solutions which are real numbers have s = -2k for integers k>=1,
; and all other solutions (which are complex) have a "real part" equal to 1/2,
; or symbolically, Re(s) = 1/2.
; | *
; | *
; * * * + * . . .
; -6 -4 -2 1/2 1 2 3
; *
; *
; *
; checking x=-2,-4,-6, ...
; y=0
;
; sum ( n^-x * ( cos(-y*ln(n)) + i*sin(-y*ln(n)) ) ) = sum ( n^-x ) = sum ( n^2 ) =
; sum(n^2, n=1..infinity); => infinity
;
; write the zeta function in recursive form then you are done.
;
; x^2+y^2=1 => x=+-(1-y^2)^1/2 let x(t)^2+y(t)^2=1 => x(t)=+-(1-y(t)^2)^1/2
; g(y)=(1-y(t)^2) f(g)=+-g^1/2 df/dg = +- 1/2 g^-1/2 dg/dy=-2y
; d/dt f = df/dg dg/dy dy/dt d/dt x(t)=+- 1/2 (1-y(t)^2)^-1/2 (-2y) dy/dt
; d/dt x(t)=+- y(t)(1-y(t)^2)^-1/2 dx/dt=+- y' y/(1-y(t)^2)^1/2 =+- y' (y^2/(1-y^2))^1/2
; x'/y'=+- sqrt(y^2/(1-y^2)) =+- sqrt(y^2/x^2)
; diff(sqrt(1-y(t)^2),t);diff(%,t);
; diff(sqrt(1-y(t)^2),t);diff(%,t);diff(%,t);
; diff(sqrt(1-y(t)^2),t);diff(%,t);diff(%,t);diff(%,t);
; you get all the circular orbit equations without postulating any further restriction :)
; d/dt f = df/dg dg/dy dy/dt this is simple geometric argument.
; small difference in df / small difference in dg
;
; continuity alone can produce lots of equations.
;
;
; x^2+y^2=R^2=[0..inf] you get a strange map of Real to infinite numbers of equations...
;
;
; maple NOTE: subs(y(t)=g(t),%); subs(diff(y(t),t)=X,%);
; diff(sqrt(1-y(t)^2),t);diff(%,t);subs(diff(y(t),t)=YP,%);
;
; diff(sqrt(1-y(t)^2),t);subs({1-y(t)^2=X^2,diff(y(t),t)=YP,y(t)=Y},%);simplify(%*X);
; -Y*YP=XP*X (1)
;
; diff(sqrt(1-y(t)^2),t);diff(%,t);
; subs({1-y(t)^2=X^2,diff(y(t),t)=YP,diff(y(t),t,t)=YPP,y(t)=Y},%);normal(%);simplify(%*X^3);
; 2 2 2 2 2
; -(Y YP + YP X + Y YPP X ) = XPP X^3 (2)
; -(X2 XP^2+ YP^2X2 + Y YPP X2) = XPP X^3
; -( XP^2+ YP^2 + Y YPP ) = XPP X (2.1)
; -( YP^2 + Y YPP X^2 ) = XPP X^3 (2.2) from (2)
;
; diff(sqrt(1-y(t)^2),t);diff(%,t);diff(%,t);
; subs({1-y(t)^2=X^2,diff(y(t),t)=YP,diff(y(t),t,t)=YPP,y(t)=Y},%);normal(%);simplify(%*X^5);
; 3 2 2 2 2 2 4 5
; -3 YP (Y YP + Y YP X + Y YPP X + YPP X ) = XPPP X
; -3 YP ( YP^2(Y^3+YX^2)+YPP(Y^2X^2+X^4) ) = XPPP X^5
; -3 YP (Y YP^2(Y^2+ X^2)+X^2YPP(Y^2+X^2) ) = XPPP X^5
; -3 YP (Y YP^2 +X^2YPP ) = XPPP X^5 [X^2+Y^2=1]
;
; diff(sqrt(1-y(t)^2),t);diff(%,t);diff(%,t);diff(%,t);
; subs({1-y(t)^2=X^2,diff(y(t),t)=YP,diff(y(t),t,t)=YPP,y(t)=Y},%);normal(%);simplify(%*X^7);
; 4 4 2 4 2 3 2 2 4 4 2 4 2 2 4 2 6
; -3 (5 Y YP + 6 Y YP X + 6 Y YP YPP X + YP X + 6 Y YP YPP X + Y YPP X + YPP X )
; = XPPPP X^7 =============== ============== ========== =======
; 4 4 2 4 2 2 2
; -3 (5 Y YP + 6 Y YP X + 6 Y YP YPP X (Y^2+X^2) + YPP^2 X^4(Y^2+X^2) + YP^4 X^4 )=XPPPP X^7
; 4 4 2 4 2 2 2
; -3 (5 Y YP + 6 Y YP X + 6 Y YP YPP X + YPP^2 X^4 + YP^4 X^4 )=XPPPP X^7
;
; diff(sqrt(1-y(t)^2),t);diff(%,t);diff(%,t);diff(%,t);diff(%,t);
; subs({1-y(t)^2=X^2,diff(y(t),t)=YP,diff(y(t),t,t)=YPP,y(t)=Y},%);normal(%);simplify(%*X^9);
;
; 3 4 2 4 2 2 4 4 2 2 4 5 4 2 6
; -15 YP (10 Y YP X + 10 Y YP YPP X + 3 Y YP X + 12 Y YP YPP X + 7 Y YP + 2 YP YPP X
; 3 2 4 2 6
; + 3 Y YPP X + 3 Y YPP X ) = XPPPPP X^9
; + 3 Y YPP^2 X^4(Y^2+X^2) ) = XPPPPP X^9
;
; diff(sqrt(1-y(t)^2),t);diff(%,t);diff(%,t);diff(%,t);diff(%,t);diff(%,t);
; subs({1-y(t)^2=X^2,diff(y(t),t)=YP,diff(y(t),t,t)=YPP,y(t)=Y},%);normal(%);simplify(%*X^11);
; 6 6 6 6 3 4 4 5 4 2 4 6
; -45 (YP X + 21 Y YP + 50 Y YP YPP X + 35 Y YP YPP X + 15 Y YP YPP X
; 4 2 2 4 2 2 2 6 2 6 4 3 3 6 4 6 2
; + 15 Y YP YPP X + 18 Y YP YPP X + 15 Y YP X + Y YPP X + 35 Y YP X
; 3 8 2 2 8
; + Y YPP X + 3 YP YPP X )
;
; sumlist:=proc(l) local s,i: s:=0: for i from 1 to nops(l) do s:=s+l[i] od: s end proc;
; nchoose2:=proc(l) lst:=l: for i from 1 to nops(lst) do for j from i+1 to nops(lst) do
; # print( subs(X^2+Y^2=X2_Y2,simplify((lst[i]+lst[j])/(X^2+Y^2))) );
; # print( type(subs(X^2+Y^2=X2_Y2,simplify((lst[i]+lst[j])/(X^2+Y^2))),freeof(X2_Y2)) );
; if type(subs(X^2+Y^2=X2_Y2,simplify((lst[i]+lst[j])/(X^2+Y^2))),freeof(X2_Y2)) then
; tmp:=simplify((lst[i]+lst[j])/(X^2+Y^2)):lst[i]:=tmp:lst[j]:=0: fi:
; od; od; sumlist(lst); end proc;
;
; i:=0;diff(sqrt(1-y(t)^2),t$i+1);
; subs({1-y(t)^2=X^2,diff(y(t),t)=YP,diff(y(t),t,t)=YPP,y(t)=Y},%); simplify(%*X^(i*2+1)/csgn(X));
;
; -Y YP = XP X
;
; i:=1;diff(sqrt(1-y(t)^2),t$i+1);
; subs({1-y(t)^2=X^2,diff(y(t),t)=YP,diff(y(t),t,t)=YPP,y(t)=Y},%); simplify(%*X^(i*2+1)/csgn(X));
; expand(%);p:=convert(%,list); p; nchoose2(p);
;
; 2 2
; -YP - Y YPP X = XPP X^3
;
; i:=2;diff(sqrt(1-y(t)^2),t$i+1);
; subs({1-y(t)^2=X^2,diff(y(t),t)=YP,diff(y(t),t,t)=YPP,y(t)=Y},%); simplify(%*X^(i*2+1)/csgn(X));
; expand(%);p:=convert(%,list): q:=nchoose2(p); nops(p); nops(q);
;
; 3 2
; -3 Y YP - 3 YP YPP X = XPPP X^5
;
; i:=3;diff(sqrt(1-y(t)^2),t$i+1);
; subs({1-y(t)^2=X^2,diff(y(t),t)=YP,diff(y(t),t,t)=YPP,y(t)=Y},%); simplify(%*X^(i*2+1)/csgn(X));
; expand(%);p:=convert(%,list): q:=nchoose2(p); nops(p); nops(q);
;
; 4 4 2 4 2 2 2 4 4 2 4
; -15 Y YP - 18 Y YP X - 18 Y YP YPP X - 3 YP X - 3 YPP X = XPPPP X^7
;
; i:=4;diff(sqrt(1-y(t)^2),t$i+1);
; subs({1-y(t)^2=X^2,diff(y(t),t)=YP,diff(y(t),t,t)=YPP,y(t)=Y},%); simplify(%*X^(i*2+1)/csgn(X));
; expand(%);p:=convert(%,list): q:=nchoose2(p); nops(p); nops(q);
;
; 5 5 3 6 3 5 2 4 3 2 5 4
;-105 Y YP - 30 YP YPP X - 150 Y YP X - 150 Y YP YPP X - 45 Y YP X
; 2 3 4 2 4
; - 180 Y YP YPP X - 45 YP Y YPP X = XPPPPP X^9
;
; i:=5;diff(sqrt(1-y(t)^2),t$i+1);
; subs({1-y(t)^2=X^2,diff(y(t),t)=YP,diff(y(t),t,t)=YPP,y(t)=Y},%); simplify(%*X^(i*2+1)/csgn(X));
; expand(%);p:=convert(%,list): q:=nchoose2(p); nops(p); nops(q);
;
; 2 2 8 4 6 2 6 6 2 6 4 6 6
;-135 YP YPP X - 1575 Y YP X - 45 YP X - 675 Y YP X - 945 Y YP
; 3 6 5 4 2 4 6
; - 45 Y YPP X - 1575 Y YP YPP X - 675 YP YPP Y X
; 3 4 4 4 2 2 4 2 2 2 6
; - 2250 Y YP YPP X - 675 Y YP YPP X - 810 Y YP YPP X
;
; i:=6;diff(sqrt(1-y(t)^2),t$i+1);
; subs({1-y(t)^2=X^2,diff(y(t),t)=YP,diff(y(t),t,t)=YPP,y(t)=Y},%); simplify(%*X^(i*2+1)/csgn(X));
; expand(%);p:=convert(%,list): q:=nchoose2(p); nops(p); nops(q);
;
; i:=7;diff(sqrt(1-y(t)^2),t$i+1);
; subs({1-y(t)^2=X^2,diff(y(t),t)=YP,diff(y(t),t,t)=YPP,y(t)=Y},%); simplify(%*X^(i*2+1)/csgn(X));
; expand(%);p:=convert(%,list): q:=nchoose2(p); nops(p); nops(q);
;
; i:=8;diff(sqrt(1-y(t)^2),t$i+1);
; subs({1-y(t)^2=X^2,diff(y(t),t)=YP,diff(y(t),t,t)=YPP,y(t)=Y},%); simplify(%*X^(i*2+1)/csgn(X));
; expand(%);p:=convert(%,list): q:=nchoose2(p); nops(p); nops(q);
;
; i:=9;diff(sqrt(1-y(t)^2),t$i+1);
; subs({1-y(t)^2=X^2,diff(y(t),t)=YP,diff(y(t),t,t)=YPP,y(t)=Y},%); simplify(%*X^(i*2+1)/csgn(X));
; expand(%);p:=convert(%,list): q:=nchoose2(p); nops(p); nops(q);
;
; i:=10;diff(sqrt(1-y(t)^2),t$i+1);
; subs({1-y(t)^2=X^2,diff(y(t),t)=YP,diff(y(t),t,t)=YPP,y(t)=Y},%); simplify(%*X^(i*2+1)/csgn(X));
; expand(%);p:=convert(%,list): q:=nchoose2(p); nops(p); nops(q);
;
;
; sumlist:=proc(l) local s,i: s:=0: for i from 1 to nops(l) do s:=s+l[i] od: s end proc;
; nchoose2:=proc(l) lst:=l: for i from 1 to nops(lst) do for j from i+1 to nops(lst) do
; if type(subs(X^2+Y^2=X2_Y2,simplify((lst[i]+lst[j])/(X^2+Y^2))),freeof(X2_Y2)) then
; tmp:=simplify((lst[i]+lst[j])/(X^2+Y^2)):lst[i]:=tmp:lst[j]:=0: fi:
; od; od; sumlist(lst); end proc;
; for i from 1 to 20 do for j from 1 to 1 do diff(sqrt(1-y(t)^2),t$i+1):
; subs({1-y(t)^2=X^2,diff(y(t),t)=YP,diff(y(t),t,t)=YPP,y(t)=Y},%): simplify(%*X^(i*2+1)/csgn(X)):
; expand(%):p:=convert(%,list): q:=nchoose2(p): print([i+1,nops(p),nops(q)]); od; od;
;
;
; no good idea:
; S:={Y*YP+XP*X,X^2+Y^2-1,XPP*X^3+(YP^2+Y*YPP*X^2)};
; with(Groebner):gb:=convert(gbasis(S,tdeg(X,Y,XP,YP,XPP,YPP)),set);
; with(Groebner):gb:=convert(gbasis(S,tdeg(XPP,YPP,XP,YP,X,Y)),set);
;
;
; idiotic idea
;
(define p 97) ;; 200th prime
(define x (map (lambda (x) (find-inverse-mod-p x p)) (interval 1 96)))
x
(let ( (port (my-open-output-file (string-append "/tmp/chaos.txt") )) )
(for-each (lambda (x) (print x port)) x)
(close-output-port port)
)
'done
; plot "/tmp/chaos.txt"
;
; do polar instead!
;
; z = r (cos theta + i sin theta) = r exp(i theta) => x=rcos theta y=rsin theta
; z = r exp(i theta)
;
; X(r(t),theta(t))=r(t)*exp(I*theta(t));
;
; seq(diff(r(t),t$(i+1))=RP||(i+1),i=0..3);
;
; j:=1; diff(r(t)*exp(I*theta(t)),t$j);
; subs({seq(diff(r(t),t$i)=RP||i,i=1..j),seq(diff(theta(t),t$i)=TP||i,i=1..j),r(t)=R,theta(t)=T},%);
; simplify(%);
; j:=2; diff(r(t)*exp(I*theta(t)),t$j);
; subs({seq(diff(r(t),t$i)=RP||i,i=1..j),seq(diff(theta(t),t$i)=TP||i,i=1..j),r(t)=R,theta(t)=T},%);
; simplify(%);
; j:=3; diff(r(t)*exp(I*theta(t)),t$j);
; subs({seq(diff(r(t),t$i)=RP||i,i=1..j),seq(diff(theta(t),t$i)=TP||i,i=1..j),r(t)=R,theta(t)=T},%);
; simplify(%);
;
;
; type to find an [iterative or not] version that works close to the orginal
; whiling taking discrete time steps.
; yes, if you can write in sine cosine form.
; do a chaos study of sine cosine!
;
; postulate your own model of universe then find equations for stable objects.
; write code.
;
;
; let z=(x+iy)
; zeta(z)=sum[n=1..inf] ( 1/n^z )
; then all solutions which are real numbers have s = -2k for integers k>=1,
; and all other solutions (which are complex) have a "real part" equal to 1/2,
; or symbolically, Re(s) = 1/2.
; | *
; | *
; * * * + * . . .
; -6 -4 -2 1/2 1 2 3
; *
; *
; *
;
; zeta(z)=sum[n=1..inf] ( 1/n^z )
;
; http://mathforum.org/library/drmath/view/52251.html
; Any real number a can be written as e^ln(a); so ; a-exp(ln(a)); => 0
; a^(ix) = (e^ln(a))^(ix)
; = e^(ix*ln(a)) ; (b^5)^3-(b)^(5*3); => 0
; = cos(x*ln(a)) + i*sin(x*ln(a))
; We can extend this to complex exponents this way:
; a^(x+iy) = a^x * a^(iy)
; To allow for complex bases, write the base in the form a*e^(ib), and you find
; [a*e^(ib)]^z = a^z * e^(ib*z)
;
; z = x + i y (1/z)=x/(x^2+y^2) + i -y/(x^2+y^2)
; n^z = n^x * n^(iy) = n^x * [ cos(y*ln(n)) + i*sin(y*ln(n)) ]
;
; 1/n^z = (n^x * cos(y*ln(n))) / ( (n^x * cos(y*ln(n)))^2 + (n^x * sin(y*ln(n)))^2 )
; + i -(n^x * sin(y*ln(n))) / ( (n^x * cos(y*ln(n)))^2 + (n^x * sin(y*ln(n)))^2 )
;
; zetaterm:=proc(n) ret:=simplify (
; (n^x * cos(y*ln(n))) / ( (n^x * cos(y*ln(n)))^2 + (n^x * sin(y*ln(n)))^2 )
; - I (n^x * sin(y*ln(n))) / ( (n^x * cos(y*ln(n)))^2 + (n^x * sin(y*ln(n)))^2 ) ) ;
; [(Re(ret) assuming x::real, y::real),(Im(ret) assuming x::real, y::real)]
; end proc:
;
;
; b^y=x => log[b] x = y
;
; (const1/x)^inf = 0 x>const1 log 0 = inf
;
;
; 1-2^(1-z) = 1- ( 2^(1 - x - i y) )= 1 - ( 2^(1-x) * 2^(i -y) )
; = 1 - ( 2^(1-x) * ( cos(-y*ln(2)) + i*sin(-y*ln(2)) ) )
; Dirichlet:= 1 - ( 2^(1-x) * ( cos(-y*ln(2)) + I*sin(-y*ln(2)) ) );
;
MAPLE_BEGIN
#interface(prettyprint=1):
#interface(screenwidth=infinity):
interface(warnlevel=0):
with(ListTools):with(Groebner):with(linalg):
numtopoly:=proc(n,b) local c,e,i,p: p:=0:
c:=convert(n,base,b): e:=[seq(x^i,i=0..nops(c)-1)]:
for i from 1 to nops(c) do p:=p+c[i]*e[i] od: p end proc:
getcoeffs:=proc(p) [seq(coeff(p,x,i),i=0..degree(p))] end proc:
poly_factorset:=proc(a,K) local x; if a=0 then {} else
{seq(x[1],x in factors(args)[2])} fi end proc:
poly_factorlists:=proc(a,K) local x; if a=0 then {} else
[[seq(x[1],x in factors(args)[2])],[seq(x[2],x in factors(args)[2])]] fi end proc:
sumlist:=proc(l) local s,i: s:=0: for i from 1 to nops(l) do s:=s+l[i] od: s end proc:
sum2lists:=proc(lst1,lst2) zip(`+`,lst1,lst2) end proc:
mean:=proc(l) m:=0: for i from 1 to nops(l) do m:=m+l[i] od: m:=m/nops(l): m end proc:
var:=proc(l) v:=0:for i from 1 to nops(l) do v:=v+(l[i]-mean(l))^2 od: v:=v/nops(l): v end proc:
cov:=proc(l1,l2) l:=0:for i from 1 to nops(l1) do l[i]:=(l1[i]-mean(l1))*(l2[i]-mean(l2)) od:
mean(convert(l,list)) end proc:
cor:=proc(l1,l2) m1:=0:m2:=0:for i from 1 to nops(l1) do m1[i]:=(l1[i]-mean(l1))/sqrt(var(l1)):
m2[i]:=(l2[i]-mean(l2))/sqrt(var(l2)): od: cov(convert(m1,list),convert(m2,list)) end proc:
cor2:=proc(l1,l2) cov(l1,l2)^2/(var(l1)*var(l2)) end proc:
takeoutx2y2:=proc(l) lst:=l: for i from 1 to nops(lst) do for j from i+1 to nops(lst) do
if type(subs(X^2+Y^2=X2_Y2,simplify((lst[i]+lst[j])/(X^2+Y^2))),freeof(X2_Y2)) then
tmp:=simplify((lst[i]+lst[j])/(X^2+Y^2)):lst[i]:=tmp:lst[j]:=0: fi:
od; od; sumlist(lst); end proc:
takeoutx2y2R2:=proc(l) lst:=l: for i from 1 to nops(lst) do for j from i+1 to nops(lst) do
if type(subs(X^2+Y^2=X2_Y2,simplify((lst[i]+lst[j])/(X^2+Y^2))),freeof(X2_Y2)) then
tmp:=simplify(R^2*(lst[i]+lst[j])/(X^2+Y^2)):lst[i]:=tmp:lst[j]:=0: fi:
od; od; sumlist(lst); end proc:
zetaterm:=proc(n) ret:=simplify (
(n^x * cos(y*ln(n))) / ( (n^x * cos(y*ln(n)))^2 + (n^x * sin(y*ln(n)))^2 )
- I (n^x * sin(y*ln(n))) / ( (n^x * cos(y*ln(n)))^2 + (n^x * sin(y*ln(n)))^2 ) );
[(Re(ret) assuming x::real, y::real),(Im(ret) assuming x::real, y::real)] end proc:
print(oooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo);
i:=0:
diff(sqrt(1-y(t)^2),t$i+1):
subs({1-y(t)^2=X^2,diff(y(t),t)=YP1,diff(y(t),t,t)=YP2,y(t)=Y},%):
simplify(%*X^(i*2+1)/csgn(X))=X*XP1;
print(oooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo);
for i from 1 to 5 do for j from 1 to 1 do
diff(sqrt(1-y(t)^2),t$i+1):
subs({1-y(t)^2=X^2,diff(y(t),t)=YP||"1",diff(y(t),t,t)=YP||"2",y(t)=Y},%):
simplify(%*X^(i*2+1)/csgn(X)):
expand(%):p:=convert(%,list): q:=takeoutx2y2(p):
print( q = XP||(i+1) * X^(i*2+1) );
od; od;
print(oooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo);
for i from 0 to 5 do for j from 1 to 1 do
diff(sqrt(R^2-y(t)^2),t$i+1):
subs({R^2-y(t)^2=X^2,diff(y(t),t)=YP||"1",diff(y(t),t,t)=YP||"2",y(t)=Y},%):
simplify(%*X^(i*2+1)/csgn(X)):
expand(%): if (i>0) then p:=convert(%,list): q:=takeoutx2y2R2(p): else q:=%: fi:
print( q = XP||(i+1) * X^(i*2+1) );
od; od;
print(oooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo);
print(abc123);
for i from 0 to 5 do for j from 1 to 1 do
diff(sqrt(R^2-y(t)^2),t$i+1):
subs({R^2-y(t)^2=X^2,diff(y(t),t)=YP||"1",diff(y(t),t,t)=YP||"2",y(t)=Y},%):
simplify(%*X^(i*2+1)/csgn(X)):
expand(%): if (i>0) then p:=convert(%,list): q:=takeoutx2y2R2(p): else q:=%: fi:
print( subs({R=0},q = XP||(i+1) * X^(i*2+1) ) );
od; od;
for i from 0 to 5 do for j from 1 to 1 do
diff(sqrt(R^2-y(t)^2),t$i+1):
subs({R^2-y(t)^2=X^2,diff(y(t),t)=YP||"1",diff(y(t),t,t)=YP||"2",y(t)=Y},%):
simplify(%*X^(i*2+1)/csgn(X)):
expand(%): if (i>0) then p:=convert(%,list): q:=takeoutx2y2R2(p): else q:=%: fi:
print( nops(subs({R=0},q)) );
od; od;
print(oooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo);
for j from 1 to 5 do for k from 1 to 1 do
diff(exp(I*theta(t)),t$j);
subs({seq(diff(r(t),t$i)=RP||i,i=1..j),seq(diff(theta(t),t$i)=TP||i,i=1..j),r(t)=R,theta(t)=T},%);
p:=simplify(%);print(p=XP||j);
od; od;
print(oooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo);
for j from 1 to 5 do for k from 1 to 1 do
diff(r(t)*exp(I*theta(t)),t$j);
subs({seq(diff(r(t),t$i)=RP||i,i=1..j),seq(diff(theta(t),t$i)=TP||i,i=1..j),r(t)=R,theta(t)=T},%);
p:=simplify(%);print(p=XP||j);
od; od;
print(oooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo);
for j from 1 to 5 do for k from 1 to 1 do
diff(r(t)*exp(I*theta(t)),t$j);
subs({seq(diff(r(t),t$i)=RP||i,i=1..j),seq(diff(theta(t),t$i)=TP||i,i=1..j),r(t)=R,theta(t)=T},%);
p:=simplify(subs({R=0},%));print(p=XP||j);
od; od;
print(oooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo);
for j from 1 to 5 do for k from 1 to 1 do
diff(r(t)*exp(I*theta(t)),t$j);
subs({seq(diff(r(t),t$i)=RP||i,i=1..j),seq(diff(theta(t),t$i)=TP||i,i=1..j),r(t)=R,theta(t)=T},%);
p:=simplify(subs({R=1},%));print(p=XP||j);
od; od;
print(oooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo);
for j from 1 to 5 do for k from 1 to 1 do
diff(r(t)*exp(I*theta(t)),t$j);
subs({seq(diff(r(t),t$i)=RP||i,i=1..j),seq(diff(theta(t),t$i)=TP||i,i=1..j),r(t)=R,theta(t)=T},%);
p:=simplify(subs({R=2},%));print(p=XP||j);
od; od;
print(oooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo);
for j from 1 to 5 do for k from 1 to 1 do
diff(r(t)*exp(I*theta(t)),t$j);
subs({seq(diff(r(t),t$i)=RP||i,i=1..j),seq(diff(theta(t),t$i)=TP||i,i=1..j),r(t)=R,theta(t)=T},%);
p:=simplify(subs({R=3},%));print(p=XP||j);
od; od;
print(oooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo);
# ?operators,precedence
# ^ binds tighter
# -2^2; => -4
interface(prettyprint=0):
for i from 1 to 3 do zetaterm(i) od;
print(oooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo);
interface(screenwidth=infinity):
Dirichlet:= 1 - ( 2^(1-x) * ( cos(-y*ln(2)) + I*sin(-y*ln(2)) ) ):
Riemann:=proc(n) ret:=simplify ( Dirichlet * (
(n^x * cos(y*ln(n))) / ( (n^x * cos(y*ln(n)))^2 + (n^x * sin(y*ln(n)))^2 )
- I (n^x * sin(y*ln(n))) / ( (n^x * cos(y*ln(n)))^2 + (n^x * sin(y*ln(n)))^2 ) ) );
[simplify(Re(ret) assuming x::real, y::real),simplify(Im(ret) assuming x::real, y::real)]
end proc:
for i from 1 to 3 do Riemann(i) od;
#
# Greek only accept geometrical proofs.
# Truth is not in the same languageo (Godel)
# Physics is not going away.
#
# x(t)^2+y(t)^2=r(t)^2
# for complex number is the only r part of the r*exp(theta)
# try to find the relation with theta(t), remember a_+b_=r_
#
# a_=x(t)+0*I
# b_=0+y(t)*I
# r_=x(t)+y(t)*I = |r_| exp(theta) sin(theta)(t)*|r_|(t)=x(t) cos(theta)(t)*|r_|(t)=y(t)
# d/dt( |r_(t)| ) => expression explosion, why?
# sin(theta)(t)^2*|r_|(t)^2=x(t)^2 (1)
# cos(theta)(t)^2*|r_|(t)^2=y(t)^2 (2)
# (1)+(2) => |r_|(t)^2=x(t)^2+y(t)^2 => exp(|r_|(t)^2)=exp(x(t)^2+y(t)^2)
# anyway, when you have some complicated equation,
# just divide left by right and you get your invariance immediately
#
# for simple dynamics: Lagrangian = T - V = kinetic energy - potential energy
# S = int t1->t2 Lagrangian(q,q') dt [principle of least action]
#
# Gravitational potential potential(x_) T=1/2 mass v_.v_ V=mass * potential(x_)
# So Lagrangian(x_,v_) = 1/2 mass v_.v_ - mass potential(x_)
#
# Euler-Lagrange equation: d/dt d/dv L - d/dx L = 0 [the calculus of variations]
#
# d/dt d/dv ( 1/2 m v_.v_ - m pot(x_) ) - d/dx ( 1/2 m v_.v_ - m pot(x_) ) = 0
# d/dt ( m v_ ) + m d/dx pot(x_) = 0
# m a_ + m d/dx pot(x_) = 0
# f_ + m d/dx pot(x_) = 0 <=> f_ = - del (gradient) V(x_)
# what happens to mass?
#
# Physicists's job is to specify T and V
# Euler-Lagrange works with any coordinate system.
#
interface(prettyprint=1):
interface(screenwidth=80):
print(oooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo);
for j from 1 to 3 do for k from 1 to 1 do
diff(sqrt(x(t)^2+y(t)^2),t$j);
p:=subs( { seq(diff(x(t),t$i)=X||i,i=1..j),
seq(diff(y(t),t$i)=Y||i,i=1..j),
x(t)=X,y(t)=Y }, %);
print(normal(p));
od;od;
MAPLE_END
# lt is for color of the points:
# -1=black 1=red 2=grn 3=blue 4=purple 5=aqua 6=brn 7=orange 8=light-brn
# pt gives a particular point type: 1=diamond 2=+ 3=square 4=X 5=triangle 6=*
cat /tmp/maple2.txt | maple -q | sed "s/ln/log/g" | sed "s/\^/**/g" \
| sed "s/^\[/splot \[0:1\] /" | sed "s/\,/\nsplot \[0:1\]/" | sed "s/\]$//"
set contour
set samples 25
set isosamples 50
set xlabel "X-axis"
set ylabel "Y-axis"
set zlabel "Z-axis"
splot [0:1] 1-2**(1-x)*cos(y*log(2))+2**(1-x)*sin(y*log(2))
splot [0:1] 2**(1-x)*sin(y*log(2))-1+2**(1-x)*cos(y*log(2))
; z = r (cos x + i sin x) = r exp(i x)
; or
; z = r (cos t + i sin t) = r exp(i t)
; z = [r cos t] + i [r sin t] = r exp(i t)
; ========= =========
; x + i y
