program intge1te; uses typ, spe, int; const e = 2.71828182845905; fnames = 'KI A0 A1 A2 A3 A4 SS SL SE V1 V2 '; ogs: array[1..11] of ArbFloat = (0, 0, 1, e, 0, 1, 0, 1, 1, 1, 1); integraaltekst: array[1..11, 1..5] of string[60] = ((' ì ', ' ô -àcosh(x) ', {k0} ' ³ e dx = k0(à), mits à > 0. ', ' õ ', '0 '), (' ì ', ' ô sin x àcos x ', {a0} ' ³ ------- + ---------- dx = 1, mits à>0 ', ' õ (x+1)à (x+1)(à+1) ', '0 '), (' ì ', ' ô 1 ', {a1} ' ³ ---- dx = 1/(à-1), mits à>1 ', ' õ xà ', '1 '), (' ì ', ' ô dx ', {a2} ' ³ --------- = 1/(à-1), mits à>1 ', ' õ x.ln(x)à ', 'e '), (' ì ', ' ô Ú àùxàùsin(xà) cos(xà)¿ ', {a3} ' ³ ³ -------------- + ---------³ dx = 1, mits à>0 ', ' õ À x(x+1) (x+1)ý Ù ', '0 '), (' ì ', ' ô Ú 2sin(«ãùxà) xàùcos(«ãùxà) ¿ ', {a4} ' ³ ³-------------- + ãà-----------------³ dx = 1, mits àò0', ' õ À (x+1)ý x(x+1) Ù ', '1 '), (' ss(n)=2*(n+1)(à-1)/n (n=1,2,3...), àò0 ', {ss} ' ss(x)=0 als min(|n-x|) ò 0.5/(n+1)à ', ' ss lineair interpoleren als min(|n-x|) ó 0.5/(n+1)à ', ' int. 0:ì = ä [1:ì] 1/(n(n+1)) = 1 ', ' '), (' ì ', ' ô sin(ln(x)) 1 ', {sl} ' ³ --------- dx = ---------, mits à>1 ', ' õ xà (à-1)ý+1 ', '1 '), (' ì ', ' ô sin(xà)-à.x(à-1).cos(xà) sin(1) ', {se} ' ³ --------------------------- dx = ------ ', ' õ ex e ', '1 '), (' ì ', ' ô à.|x|(à-1) ', {v1} ' ³ ---------------- dx = 1, mits à > 0 ', ' õ ã.(|x|(2à) + 1) ', '-ì '), (' ì 0 ì ', ' ô ô àx ô -x/à ', {v2} ' ³ v2(x)dx = ³ e dx + ³ e dx = à + 1/à, mits à > 0', ' õ õ õ ', '-ì -ì 0 ')); var alfa, ond, inte, int1: ArbFloat; u, i: ArbInt; s: string; q: char; f: rfunc1r; scale: boolean; function Ki(x: ArbFloat): ArbFloat; var kk: ArbFloat; begin if abs(x) < ln(100 / alfa) then kk := Exp(-alfa * Specoh(x)) else kk := 0; if scale then ki := kk / int1 else ki := kk; end; function uki(u: ArbFloat): ArbFloat; {u=1/(x+1), of x=1/u-1} begin if u > 0 then uki := ki((1 - u) / u) / sqr(u) else uki := 0; end; function a0(x: ArbFloat): ArbFloat; begin a0 := ((x + 1) * sin(x) + alfa * cos(x)) * spepow(x + 1, -alfa - 1); end; function ua0(u: ArbFloat): ArbFloat; {u=1/(x+1), of x=1/u-1} begin if u > 0 then ua0 := a0((1 - u) / u) / sqr(u) else ua0 := 0; end; function a1(x: ArbFloat): ArbFloat; var a: ArbFloat; begin a := spepow(x, -alfa); if scale then a1 := (alfa - 1) * a else a1 := a; end; function ua1(u: ArbFloat): ArbFloat; {u=ond/x of x=ond/u} begin if u > 0 then ua1 := a1(ond / u) * ond / sqr(u) else ua1 := 0; end; function a2(x: ArbFloat): ArbFloat; var a: ArbFloat; begin a := spepow(ln(x), -alfa) / x; if scale then a2 := (alfa - 1) * a else a2 := a; end; function ua2(u: ArbFloat): ArbFloat; {u=ond/x of x=ond/u} begin if u > 0 then ua2 := a2(ond / u) * ond / sqr(u) else ua2 := 0; end; function a3(x: ArbFloat): ArbFloat; var y: ArbFloat; begin if x = 0 then a3 := 0 else begin y := spepow(x, alfa); a3 := alfa * y * sin(y) / (x * (x + 1)) + cos(y) / sqr(x + 1); end; end; function ua3(u: ArbFloat): ArbFloat; {u=1/(x+1), of x=1/u-1} begin if u > 0 then ua3 := a3((1 - u) / u) / sqr(u) else ua3 := 0; end; function a4(x: ArbFloat): ArbFloat; var y, z: ArbFloat; begin y := spepow(x, alfa); z := y * pi / 2; a4 := 2 * sin(z) / sqr(x + 1) - pi * alfa * y * cos(z) / (x * (x + 1)); end; function ua4(u: ArbFloat): ArbFloat; {u=ond/x of x=ond/u} begin if u > 0 then ua4 := a4(ond / u) * ond / sqr(u) else ua4 := 0; end; function ss(x: ArbFloat): ArbFloat; var d, eps, r: ArbFloat; begin if x > 0.5 then begin d := frac(x); r := x - d; if d > 0.5 then begin d := 1 - d; r := r + 1; end; eps := 0.5 / spepow(r + 1, alfa); if d > eps then ss := 0 else ss := (1 - d / eps) / (r * (r + 1) * eps); end else ss := 0; end; function uss(u: ArbFloat): ArbFloat; {u=ond/x of x=ond/u} begin if u > 0 then uss := ss(ond / u) * ond / sqr(u) else uss := 0; end; function sl(x: ArbFloat): ArbFloat; var sl1: ArbFloat; begin sl1 := sin(ln(x)) * spepow(x, -alfa); if scale then sl := sl1 / int1 else sl := sl1; end; function usl(u: ArbFloat): ArbFloat; {u=ond/x of x=ond/u} begin if u > 0 then usl := sl(ond / u) * ond / sqr(u) else usl := 0; end; function se(x: ArbFloat): ArbFloat; var y, se1: ArbFloat; begin y := spepow(x, alfa); se1 := (sin(y) - alfa * (y / x) * cos(y)) * exp(-x); if scale then se := se1 / int1 else se := se1; end; function use(u: ArbFloat): ArbFloat; {u=ond/x of x=ond/u} begin if u > 0 then use := se(ond / u) * ond / sqr(u) else use := 0; end; function v1(x: ArbFloat): ArbFloat; var a, y: ArbFloat; begin x := abs(x); alfa := abs(alfa); if x = 0 then begin if alfa = 1 then v1 := alfa / pi else v1 := 0; end else begin if x > 1 then a := -alfa - 1 else a := alfa - 1; y := spepow(x, a); v1 := alfa * y / (pi * (sqr(x * y) + 1)); end; end; function uv1(u: ArbFloat): ArbFloat; { u=«((2/ã)arctan(x)+1) of x=tan(«ã(2u-1)) } var y: ArbFloat; { 0 ó u ó 1 } begin if (u = 0) or (u = 1) then uv1 := 0 else begin y := 1 / sqr(cos(pi * (u - 0.5))); uv1 := pi * v1(sqrt(y - 1)) * y; end; end; function v2(x: ArbFloat): ArbFloat; var v: ArbFloat; begin alfa := abs(alfa); if x > 0 then v := exp(-x / alfa) else if x < 0 then v := exp(x * alfa) else v := 1; if scale then v2 := v / (alfa + 1 / alfa) else v2 := v; end; function uv2(u: ArbFloat): ArbFloat; { u=«((2/ã)arctan(x)+1) of x=tan(«ã(2u-1)) } var y: ArbFloat; { 0 ó u ó 1 } begin if (u = 0) or (u = 1) then uv2 := 0 else begin y := 1 / sqr(cos(pi * (u - 0.5))); if u > 0.5 then uv2 := pi * v2(sqrt(y - 1)) * y else uv2 := pi * v2(-sqrt(y - 1)) * y; end; end; var integral, ae, err: ArbFloat; term, num2: ArbInt; intex, First: boolean; procedure Header; var i: ArbInt; begin for i := 1 to 5 do if i = 3 then writeln(s: 3, ': ', Integraaltekst[u, i]) else writeln('': 5, Integraaltekst[u, i]); end; procedure ShowResults; var f: ArbFloat; begin if First then writeln('alfa': num2, '': numdig - num2, 'ae': 7, ' ': 4, 'int': num2, '': numdig - num2, ' ', 'err': 7, ' ': 4, 'f': 6); First := False; if intex then f := inte - integral; case term of 1: begin Write(alfa: numdig, ae: 10, integral: numdig, ' ', err: 10, ' '); if intex then writeln(f: 10) else writeln; end; 2: begin Write(alfa: numdig, ae: 10, integral: numdig, ' ', err: 10, ' '); if intex then writeln(f: 10) else writeln; Writeln(' proces afgebroken, te hoge nauwkeurigheid?'); end; 3: Writeln('Verkeerde waarde ae (<=0) bij aanroep: ', ae: 8); 4: begin Write(alfa: numdig, ae: 10, integral: numdig, ' ', err: 10, ' '); if intex then writeln(f: 10) else writeln; writeln(' proces afgebroken, moeilijk, mogelijk divergent?'); end; end; end; const fint: array[boolean, 1..11] of rfunc1r = ((@ki, @a0, @a1, @a2, @a3, @a4, @ss, @sl, @se, @v1, @v2), (@uki, @ua0, @ua1, @ua2, @ua3, @ua4, @uss, @usl, @use, @uv1, @uv2)); begin s := ParamStr(1); if s = '' then begin writeln(' Vergeten functienaam mee te geven!'); writeln(' Kies uit: ', fnames); halt; end; for i := 1 to length(s) do s[i] := Upcase(s[i]); u := (Pos(s, fnames) + 2) div 3; if u = 0 then begin writeln(' Commandlineparameter ', s, ' bestaat niet'); writeln(' Kies uit: ', fnames); halt; end; Write('program results int1fr function ' + s); case SizeOf(ArbFloat) of 4: writeln('(single)'); 8: writeln('(double)'); 6: writeln('(real)'); end; num2 := numdig div 2; if Pos(s, 'a0 a4 a3 ss v1') > 0 then scale := True else begin Write(' scale ? (y or n)'); readln(q); scale := Upcase(q) = 'Y'; end; Write('Transformatie naar 0 => 1 ? (y or n)'); readln(q); ond := ogs[u]; f := fint[Upcase(q) = 'Y'][u]; Header; Writeln('à en ae: '); First := True; while not eoln do begin Read(alfa, ae); intex := True; case u of 1: int1 := spebk0(alfa); 2: begin int1 := 1; intex := alfa > 0; end; 3: begin if alfa > 1 then int1 := 1 / (alfa - 1); intex := alfa > 1; end; 4: begin if alfa > 1 then int1 := 1 / (alfa - 1); intex := alfa > 1; end; 5: begin if alfa > 0 then int1 := 1 else int1 := cos(1); intex := alfa > 0; end; 6: begin int1 := 1; intex := alfa > 0; end; 7: int1 := 1; 8: begin if alfa > 1 then int1 := 1 / (sqr(alfa - 1) + 1); intex := alfa > 1; end; 9: int1 := sin(1) / e; 10: begin int1 := 1; intex := alfa <> 0; end; 11: begin if alfa <> 0 then int1 := abs(alfa) + 1 / abs(alfa); intex := alfa <> 0; end; end; if scale then inte := 1 else inte := int1; if Upcase(q) = 'Y' then int1fr(f, 0, 1, ae, integral, err, term) else if u < 10 then int1fr(f, ond, infinity, ae, integral, err, term) else int1fr(f, -infinity, infinity, ae, integral, err, term); Showresults; end; end. program intge1te; uses typ, spe, int; const e = 2.71828182845905; fnames = 'KI A0 A1 A2 A3 A4 SS SL SE V1 V2 '; ogs: array[1..11] of ArbFloat = (0, 0, 1, e, 0, 1, 0, 1, 1, 1, 1); integraaltekst: array[1..11, 1..5] of string[60] = ((' ì ', ' ô -àcosh(x) ', {k0} ' ³ e dx = k0(à), mits à > 0. ', ' õ ', '0 '), (' ì ', ' ô sin x àcos x ', {a0} ' ³ ------- + ---------- dx = 1, mits à>0 ', ' õ (x+1)à (x+1)(à+1) ', '0 '), (' ì ', ' ô 1 ', {a1} ' ³ ---- dx = 1/(à-1), mits à>1 ', ' õ xà ', '1 '), (' ì ', ' ô dx ', {a2} ' ³ --------- = 1/(à-1), mits à>1 ', ' õ x.ln(x)à ', 'e '), (' ì ', ' ô Ú àùxàùsin(xà) cos(xà)¿ ', {a3} ' ³ ³ -------------- + ---------³ dx = 1, mits à>0 ', ' õ À x(x+1) (x+1)ý Ù ', '0 '), (' ì ', ' ô Ú 2sin(«ãùxà) xàùcos(«ãùxà) ¿ ', {a4} ' ³ ³-------------- + ãà-----------------³ dx = 1, mits àò0', ' õ À (x+1)ý x(x+1) Ù ', '1 '), (' ss(n)=2*(n+1)(à-1)/n (n=1,2,3...), àò0 ', {ss} ' ss(x)=0 als min(|n-x|) ò 0.5/(n+1)à ', ' ss lineair interpoleren als min(|n-x|) ó 0.5/(n+1)à ', ' int. 0:ì = ä [1:ì] 1/(n(n+1)) = 1 ', ' '), (' ì ', ' ô sin(ln(x)) 1 ', {sl} ' ³ --------- dx = ---------, mits à>1 ', ' õ xà (à-1)ý+1 ', '1 '), (' ì ', ' ô sin(xà)-à.x(à-1).cos(xà) sin(1) ', {se} ' ³ --------------------------- dx = ------ ', ' õ ex e ', '1 '), (' ì ', ' ô à.|x|(à-1) ', {v1} ' ³ ---------------- dx = 1, mits à > 0 ', ' õ ã.(|x|(2à) + 1) ', '-ì '), (' ì 0 ì ', ' ô ô àx ô -x/à ', {v2} ' ³ v2(x)dx = ³ e dx + ³ e dx = à + 1/à, mits à > 0', ' õ õ õ ', '-ì -ì 0 ')); var alfa, ond, inte, int1: ArbFloat; u, i: ArbInt; s: string; q: char; f: rfunc1r; scale: boolean; function Ki(x: ArbFloat): ArbFloat; var kk: ArbFloat; begin if abs(x) < ln(100 / alfa) then kk := Exp(-alfa * Specoh(x)) else kk := 0; if scale then ki := kk / int1 else ki := kk; end; function uki(u: ArbFloat): ArbFloat; {u=1/(x+1), of x=1/u-1} begin if u > 0 then uki := ki((1 - u) / u) / sqr(u) else uki := 0; end; function a0(x: ArbFloat): ArbFloat; begin a0 := ((x + 1) * sin(x) + alfa * cos(x)) * spepow(x + 1, -alfa - 1); end; function ua0(u: ArbFloat): ArbFloat; {u=1/(x+1), of x=1/u-1} begin if u > 0 then ua0 := a0((1 - u) / u) / sqr(u) else ua0 := 0; end; function a1(x: ArbFloat): ArbFloat; var a: ArbFloat; begin a := spepow(x, -alfa); if scale then a1 := (alfa - 1) * a else a1 := a; end; function ua1(u: ArbFloat): ArbFloat; {u=ond/x of x=ond/u} begin if u > 0 then ua1 := a1(ond / u) * ond / sqr(u) else ua1 := 0; end; function a2(x: ArbFloat): ArbFloat; var a: ArbFloat; begin a := spepow(ln(x), -alfa) / x; if scale then a2 := (alfa - 1) * a else a2 := a; end; function ua2(u: ArbFloat): ArbFloat; {u=ond/x of x=ond/u} begin if u > 0 then ua2 := a2(ond / u) * ond / sqr(u) else ua2 := 0; end; function a3(x: ArbFloat): ArbFloat; var y: ArbFloat; begin if x = 0 then a3 := 0 else begin y := spepow(x, alfa); a3 := alfa * y * sin(y) / (x * (x + 1)) + cos(y) / sqr(x + 1); end; end; function ua3(u: ArbFloat): ArbFloat; {u=1/(x+1), of x=1/u-1} begin if u > 0 then ua3 := a3((1 - u) / u) / sqr(u) else ua3 := 0; end; function a4(x: ArbFloat): ArbFloat; var y, z: ArbFloat; begin y := spepow(x, alfa); z := y * pi / 2; a4 := 2 * sin(z) / sqr(x + 1) - pi * alfa * y * cos(z) / (x * (x + 1)); end; function ua4(u: ArbFloat): ArbFloat; {u=ond/x of x=ond/u} begin if u > 0 then ua4 := a4(ond / u) * ond / sqr(u) else ua4 := 0; end; function ss(x: ArbFloat): ArbFloat; var d, eps, r: ArbFloat; begin if x > 0.5 then begin d := frac(x); r := x - d; if d > 0.5 then begin d := 1 - d; r := r + 1; end; eps := 0.5 / spepow(r + 1, alfa); if d > eps then ss := 0 else ss := (1 - d / eps) / (r * (r + 1) * eps); end else ss := 0; end; function uss(u: ArbFloat): ArbFloat; {u=ond/x of x=ond/u} begin if u > 0 then uss := ss(ond / u) * ond / sqr(u) else uss := 0; end; function sl(x: ArbFloat): ArbFloat; var sl1: ArbFloat; begin sl1 := sin(ln(x)) * spepow(x, -alfa); if scale then sl := sl1 / int1 else sl := sl1; end; function usl(u: ArbFloat): ArbFloat; {u=ond/x of x=ond/u} begin if u > 0 then usl := sl(ond / u) * ond / sqr(u) else usl := 0; end; function se(x: ArbFloat): ArbFloat; var y, se1: ArbFloat; begin y := spepow(x, alfa); se1 := (sin(y) - alfa * (y / x) * cos(y)) * exp(-x); if scale then se := se1 / int1 else se := se1; end; function use(u: ArbFloat): ArbFloat; {u=ond/x of x=ond/u} begin if u > 0 then use := se(ond / u) * ond / sqr(u) else use := 0; end; function v1(x: ArbFloat): ArbFloat; var a, y: ArbFloat; begin x := abs(x); alfa := abs(alfa); if x = 0 then begin if alfa = 1 then v1 := alfa / pi else v1 := 0; end else begin if x > 1 then a := -alfa - 1 else a := alfa - 1; y := spepow(x, a); v1 := alfa * y / (pi * (sqr(x * y) + 1)); end; end; function uv1(u: ArbFloat): ArbFloat; { u=«((2/ã)arctan(x)+1) of x=tan(«ã(2u-1)) } var y: ArbFloat; { 0 ó u ó 1 } begin if (u = 0) or (u = 1) then uv1 := 0 else begin y := 1 / sqr(cos(pi * (u - 0.5))); uv1 := pi * v1(sqrt(y - 1)) * y; end; end; function v2(x: ArbFloat): ArbFloat; var v: ArbFloat; begin alfa := abs(alfa); if x > 0 then v := exp(-x / alfa) else if x < 0 then v := exp(x * alfa) else v := 1; if scale then v2 := v / (alfa + 1 / alfa) else v2 := v; end; function uv2(u: ArbFloat): ArbFloat; { u=«((2/ã)arctan(x)+1) of x=tan(«ã(2u-1)) } var y: ArbFloat; { 0 ó u ó 1 } begin if (u = 0) or (u = 1) then uv2 := 0 else begin y := 1 / sqr(cos(pi * (u - 0.5))); if u > 0.5 then uv2 := pi * v2(sqrt(y - 1)) * y else uv2 := pi * v2(-sqrt(y - 1)) * y; end; end; var integral, ae, err: ArbFloat; term, num2: ArbInt; intex, First: boolean; procedure Header; var i: ArbInt; begin for i := 1 to 5 do if i = 3 then writeln(s: 3, ': ', Integraaltekst[u, i]) else writeln('': 5, Integraaltekst[u, i]); end; procedure ShowResults; var f: ArbFloat; begin if First then writeln('alfa': num2, '': numdig - num2, 'ae': 7, ' ': 4, 'int': num2, '': numdig - num2, ' ', 'err': 7, ' ': 4, 'f': 6); First := False; if intex then f := inte - integral; case term of 1: begin Write(alfa: numdig, ae: 10, integral: numdig, ' ', err: 10, ' '); if intex then writeln(f: 10) else writeln; end; 2: begin Write(alfa: numdig, ae: 10, integral: numdig, ' ', err: 10, ' '); if intex then writeln(f: 10) else writeln; Writeln(' proces afgebroken, te hoge nauwkeurigheid?'); end; 3: Writeln('Verkeerde waarde ae (<=0) bij aanroep: ', ae: 8); 4: begin Write(alfa: numdig, ae: 10, integral: numdig, ' ', err: 10, ' '); if intex then writeln(f: 10) else writeln; writeln(' proces afgebroken, moeilijk, mogelijk divergent?'); end; end; end; const fint: array[boolean, 1..11] of rfunc1r = ((@ki, @a0, @a1, @a2, @a3, @a4, @ss, @sl, @se, @v1, @v2), (@uki, @ua0, @ua1, @ua2, @ua3, @ua4, @uss, @usl, @use, @uv1, @uv2)); begin s := ParamStr(1); if s = '' then begin writeln(' Vergeten functienaam mee te geven!'); writeln(' Kies uit: ', fnames); halt; end; for i := 1 to length(s) do s[i] := Upcase(s[i]); u := (Pos(s, fnames) + 2) div 3; if u = 0 then begin writeln(' Commandlineparameter ', s, ' bestaat niet'); writeln(' Kies uit: ', fnames); halt; end; Write('program results int1fr function ' + s); case SizeOf(ArbFloat) of 4: writeln('(single)'); 8: writeln('(double)'); 6: writeln('(real)'); end; num2 := numdig div 2; if Pos(s, 'a0 a4 a3 ss v1') > 0 then scale := True else begin Write(' scale ? (y or n)'); readln(q); scale := Upcase(q) = 'Y'; end; Write('Transformatie naar 0 => 1 ? (y or n)'); readln(q); ond := ogs[u]; f := fint[Upcase(q) = 'Y'][u]; Header; Writeln('à en ae: '); First := True; while not eoln do begin Read(alfa, ae); intex := True; case u of 1: int1 := spebk0(alfa); 2: begin int1 := 1; intex := alfa > 0; end; 3: begin if alfa > 1 then int1 := 1 / (alfa - 1); intex := alfa > 1; end; 4: begin if alfa > 1 then int1 := 1 / (alfa - 1); intex := alfa > 1; end; 5: begin if alfa > 0 then int1 := 1 else int1 := cos(1); intex := alfa > 0; end; 6: begin int1 := 1; intex := alfa > 0; end; 7: int1 := 1; 8: begin if alfa > 1 then int1 := 1 / (sqr(alfa - 1) + 1); intex := alfa > 1; end; 9: int1 := sin(1) / e; 10: begin int1 := 1; intex := alfa <> 0; end; 11: begin if alfa <> 0 then int1 := abs(alfa) + 1 / abs(alfa); intex := alfa <> 0; end; end; if scale then inte := 1 else inte := int1; if Upcase(q) = 'Y' then int1fr(f, 0, 1, ae, integral, err, term) else if u < 10 then int1fr(f, ond, infinity, ae, integral, err, term) else int1fr(f, -infinity, infinity, ae, integral, err, term); Showresults; end; end.