[1] | 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))
|
---|