1 | ;;
|
---|
2 | ;; A computation of the places at which flip bifurcation occurrs in the
|
---|
3 | ;; quadratic family
|
---|
4 | ;; Note: period 3 finished quite easily, period 4 runs forever
|
---|
5 | ;; Two methods: grobner and resultant
|
---|
6 | ;;
|
---|
7 |
|
---|
8 |
|
---|
9 | (setf order (elimination-order
|
---|
10 | 2
|
---|
11 | :primary-order #'grevlex>
|
---|
12 | :secondary-order #'grevlex>
|
---|
13 | ))
|
---|
14 |
|
---|
15 | (setf f (cdr (string-read-poly "[a-x^2+b*y,x,a,b]" '(x y a b) :order order)))
|
---|
16 | (setf id (cdr (string-read-poly "[x,y,a,b]" '(x y a b) :order order)))
|
---|
17 | (setf one (string-read-poly "1" '(x y a b) :order order))
|
---|
18 |
|
---|
19 | (defun f-composition (n) (poly-dynamic-power f n order))
|
---|
20 |
|
---|
21 | ;; Flip bifurcations occur when derivative is -1 at some fixed point
|
---|
22 | ;; g
|
---|
23 | (defun g (n) (subseq (mapcar #'(lambda (x y) (poly- x y order))
|
---|
24 | (f-composition n) id) 0 2))
|
---|
25 | (defun f-jacobian (n) (characteristic-polynomial (jacobi-matrix (f-composition n) 2 2)
|
---|
26 | order))
|
---|
27 | (defun flip-value (n) (poly-scalar-composition
|
---|
28 | (f-jacobian n)
|
---|
29 | (cdr (string-read-poly "[x,y,a,b,-1]" '(x y a b) :order order))
|
---|
30 | order))
|
---|
31 |
|
---|
32 |
|
---|
33 | (defun ideal (n) (cons (flip-value n) (g n)))
|
---|
34 |
|
---|
35 | (defun print-ideal (n) (poly-print (cons '[ (ideal n)) '(x y a b)) (terpri))
|
---|
36 |
|
---|
37 | (defun bifurcation (n)
|
---|
38 | (mapcar #'(lambda (x) (poly-contract x 2))
|
---|
39 | (elimination-ideal (ideal n) 2
|
---|
40 | :order order
|
---|
41 | )))
|
---|
42 |
|
---|
43 | (defun print-bifurcation (n)
|
---|
44 | (poly-print (cons '[ (bifurcation n)) '(a b))
|
---|
45 | (terpri))
|
---|