extra/math/runge-kutta/examples/examples.factor

   1 USING: kernel io accessors arrays math.runge-kutta sequences math math.matrices
   2        ui.gadgets ui.gadgets.charts ui.gadgets.panes ui.gadgets.charts.lines ui.theme ;
   3 IN: math.runge-kutta.examples
   4
   5 : lorenz-dx/dt ( tx..n -- dx )
   6     rest first2
   7     swap - 10 * ;
   8
   9 : lorenz-dy/dt ( tx..n -- dy )
  10     rest first3
  11     28 swap - swapd * swap - ;
  12
  13 : lorenz-dz/dt ( tx..n -- dz )
  14     rest first3
  15     [ * ] dip 8/3 * - ;
  16
  17 : <lorenz> ( -- dx..n/dt delta tx..n t-limit )
  18     { [ lorenz-dx/dt ] [ lorenz-dy/dt ] [ lorenz-dz/dt ] } 0.01 { 0 0 1 21/20 } 150 ;
  19
  20
  21 : lorenz. ( -- )
  22     chart new { { -20 20 } { -20 20 } } >>axes
  23     line new link-color >>color
  24              <lorenz> <runge-kutta-4> { 0 3 } cols-except >>data
  25     add-gadget
  26     gadget. ;
  27
  28
  29 :: rf-dx/dt ( tx..n gamma -- dx )
  30     tx..n rest first3 :> ( x y z )
  31     y z 1 - x sq + * gamma x * + ;
  32
  33 :: rf-dy/dt ( tx..n gamma -- dy )
  34     tx..n rest first3 :> ( x y z )
  35     x 3 z * 1 + x sq - * gamma y * + ;
  36
  37 :: rf-dz/dt ( tx..n alpha -- dz )
  38     tx..n rest first3 :> ( x y z )
  39     -2 z * alpha x y * + * ;
  40
  41 :: <rabinovich-fabrikant> ( gamma alpha -- dx..n/dt delta tx..n t-limit )
  42     gamma '[ _ rf-dx/dt ] gamma '[ _ rf-dy/dt ] alpha '[ _ rf-dz/dt ]
  43     3array
  44     0.01 { 0 -1 0 0.5 } 150 ;
  45
  46
  47 : rabinovich-fabrikant. ( -- )
  48     chart new { { -2 2 } { -2 2 } } >>axes
  49     line new link-color >>color
  50              0.1 0.14 <rabinovich-fabrikant> <runge-kutta-4> { 0 3 } cols-except >>data
  51              add-gadget
  52     gadget. ;