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

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