summaryrefslogtreecommitdiff
path: root/Master/texmf-dist/dvips/pst-func/pst-func.pro
blob: 580e702c837fdf9462410fd26a20379663da56f4 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
%%
%% This is file `pst-func.pro',
%%
%% IMPORTANT NOTICE:
%%
%% Package `pst-func.tex'
%%
%% Herbert Voss <voss _at_ perce.de>
%%
%% This program can be redistributed and/or modified under the terms
%% of the LaTeX Project Public License Distributed from CTAN archives
%% in directory macros/latex/base/lppl.txt.
%%
%% DESCRIPTION:
%%   `pst-func' is a PSTricks package to plot special math functions
%%
%%
%% version 0.02 / 2004-11-08  Herbert Voss <voss _at_ pstricks.de>
%
/tx@FuncDict 40 dict def
tx@FuncDict begin
%
/eps1 1.0e-05 def
/eps2 1.0e-04 def
/MaxIter 255 def
/func { coeff Derivation FuncValue } def
/func' { coeff Derivation 1 add FuncValue } def
/func'' { coeff Derivation 2 add FuncValue } def
%
/NewtonMehrfach {% the start value must be on top of the stack
  /Nx exch def 
  /Iter 0 def
  {
    /Iter Iter 1 add def
    Nx func /F exch def % f(Nx)
    F abs eps2 lt { exit } if
    Nx func' /FS exch def % f'(Nx) 
    FS 0 eq { /FS 1.0e-06 def } if
    Nx func'' /F2S exch def % f''(Nx)
    1.0 1.0 F F2S mul FS dup mul div sub div /J exch def
    J F mul FS div /Diff exch def 
    /Nx Nx Diff sub def
    Diff abs eps1 lt Iter MaxIter gt or { exit } if 
  } loop 
  Nx % the returned value ist the zero point
} def

/Steffensen {% the start value must be on top of the stack
  /y0 exch def % the start value
  /Iter 0 def
  {
    y0 func /F exch def
    F abs eps2 lt { exit } if
    y0 F sub /Phi exch def
    Phi func /F2 exch def
    F2 abs eps2 le { exit }{
      Phi y0 sub dup mul Phi F2 sub 2 Phi mul sub y0 add div /Diff exch def
      y0 Diff sub /y0 exch def
      Diff abs eps1 le { exit } if
    } ifelse
    /Iter Iter 1 add def
    Iter MaxIter gt { exit } if
  } loop
  y0 % the returned value ist the zero point
} def 
%
/Horner {% x [coeff] must be on top of the stack
  aload length
  dup 2 add -1 roll
  exch 1 sub {
    dup 4 1 roll
    mul add exch
  } repeat
  pop % the y value is on top of the stack
} def
%
/FuncValue {% x [coeff] Derivation must be on top of the stack
  {
    aload 			% a0 a1 a2 ... a(n-1) [array]
    length                      % a0 a1 a2 ... a(n-1) n
    1 sub /grad exch def        % a0 a1 a2 ... a(n-1) 
    grad -1 1 {                 % for n=grad step -1 until 1
      /n exch def               % Laufvariable speichern
      n                         % a0 a1 a2 ... a(n-1) n
      mul                       % a0 a1 a2 ... a(n-1)*n 
      grad 1 add                % a0 a1 a2 ... a(n-1)*n grad+1 
      1 roll                    % an*na0 a1 a2 ... a(n-2)
    } for
    pop                         % loesche a0
    grad array astore           % [ a1 a2 ... a(n-2)]
  } repeat
  Horner
} def
%
/FindZeros { % dxN dxZ must be on top of the stack (x0..x1 the intervall)
  /dxZ exch def /dxN exch def
  /pstZeros [] def 
  x0 dxZ x1 { % suche Nullstellen
    /xWert exch def
    xWert NewtonMehrfach 
    %xWert Steffensen 
    /xNull exch def 
    pstZeros aload length /Laenge exch def % now test if value is a new one
    Laenge 0 eq 
      { xNull 1 }
      { /newZero true def
        Laenge {
	  xNull sub abs dxN lt { /newZero false def } if
        } repeat
	pstZeros aload pop
        newZero { xNull Laenge 1 add } { Laenge } ifelse } ifelse
    array astore /pstZeros exch def
  } for
} def
%
%
end