comment Programma t.b.v. dr Paskin. M L Potters, opdracht R 602, code-nr MLP 250361/1132; begin integer Z; real procedure zero 1 (x, a, dx, b, f, exit, eps, eta); value eta; real x, a, dx, b, f, eps, eta; label exit; begin real x0, x1, x2, x3, f0, f1, f2, f3, tweps; integer s; x:= x1:= a; f1:= f; s:= sign (f1); tweps:= 2 * eps; start: if sign(b - a) != sign (dx) then goto exit; a:= x:= x2:= x1 + dx; if sign (x2 - b) = sign (x2 - x1) then a:= x:= x2:= b; f2:= f; if sign (f2) = s then begin x1:= x2; f1:= f2; goto start end; x0:= x1; f0:= f1; step: x:= x3:= (x1 * f2 - x2 * f1)/(f2 - f1); if sign(x3 - x0)= sign(x3 - x2) then begin x1:= x0; f1:= f0; goto step end; f3:= f; if f3 != 0 then begin if sign(f3) = s then begin x0:= x2; f0:= f2; s:= -s end; if comp(x3, x2, eta) > tweps then begin x1:= x2; f1:= f2; x2:= x3; f2:= f3; goto step end; if comp (x3, x0, eta) <= tweps then goto klaar; x:= x3; next: x:= x + tweps * sign (x0 - x3) * (if abs (x3) > eta then x3 else eta); f2:= f; if f3 * f2 >= 0 then begin x3:= x; f3:= f2; goto next end; x0:= x; klaar: zero 1:= (x0 + x3)/2 end else zero 1:= x3 end zero 1; real procedure comp(a,b,c); value a,b,c; real a,b,c; begin a:= abs(a); b:= abs(b); if a>b then begin if a>c then comp:= 1 - b/a else comp:=(a - b)/c end else if b>c then comp:= 1 - a/b else comp:=(b - a)/c end comp; real procedure bin (a, b); value a, b; integer a, b; begin integer i; real c; c:= 1; if 2 * b > a then b:= a - b; for i:= 1 step 1 until b do c:= (a - i + 1) * c/i; bin:= c end bin; for Z:= 6, 8 do begin integer i; for i:= 0 step 1 until 6 do begin real a, b, ETc, lnETc, ET, lnET, x, y, D, S, SIGMA, E; integer n, beta; real array alpha, coeff, gamma, omega, sigma[0 : Z], c1, c2[1 : Z - 1]; procedure calc 1; begin lnET:= 100 * lnETc / beta; ET:= exp (lnET); NLCR; print (-1/lnET); for n:= 0 step 1 until Z do alpha[n]:= bin (Z, n) * ET ** (n * (1 - a * n)) end calc 1; procedure calc 2; begin for n:= 0 step 1 until Z do sigma[n]:= (gamma[Z - n] + omega[n]) / (D * Z); SIGMA:= 2 * SUM (n, 0, Z, n * sigma[n]) - 1; print (SIGMA); E:= Z * lnETc * SUM (n, 0, Z, (Z - n) * (1 - a * (Z - n)) * sigma[n]); print (E) end calc 2; AA: a:= 0.12 * i/Z; for n:= 1 step 1 until Z - 1 do begin c1[n]:= (2 * n - Z + 2) * bin (Z - 1, n); c2[n]:= n * (1 - a * (2 + n)) end; b:= 0; ETc:= zero 1 (y, b, .125, 1, 2 - Z + SUM (n, 1, Z - 1, c1[n] * y ** c2[n]), SS, '-6, 1); lnETc:= ln (ETc); NLCR; print (Z); print (a); print (-1/lnETc); NLCR; S1: for beta:= 30, 40, 50 step 5 until 75, 80 step 2 until 88, 90 step 1 until 99 do begin real procedure poly (v); value v; real v; begin real pol; pol:= coeff[Z]; for n:= Z - 1 step -1 until 0 do pol:= pol * v + coeff[n]; poly:= pol end poly; calc 1; for n:= 0 step 1 until Z do coeff[n]:= n * alpha[n] - (Z - n) * alpha [Z - n]; b:= 0; x:= zero 1 (y, b, .5 - .5 * y, 1, poly (y), SS, '-6, 1); print (x); for n:= 0 step 1 until Z do begin real p; p:= x ** n; gamma[n]:= alpha[n] * p; omega[n]:= alpha[Z - n] * p end; D:= SUM (n, 0, Z, gamma[n] + omega[n]); S:= SUM (n, 0, Z, gamma[n] - omega [n]) / D; print (S); calc 2 end S1; NLCR; S2: for beta:= 100 step 10 until 200 do begin calc 1; TAB; TAB; for n:= 0 step 1 until Z do begin gamma[n]:= alpha[n]; omega[n]:= alpha[Z - n] end; D:= SUM (n, 0, Z, gamma[n] + omega[n]); calc 2 end S2; SS: stop end i cycle end Z cycle end comment Programma t.b.v. dr Paskin. M L Potters, opdracht R 602, code-nr MLP 250361/1132; begin integer Z; real procedure zero 1 (x, a, dx, b, f, exit, eps, eta); value eta; real x, a, dx, b, f, eps, eta; label exit; begin real x0, x1, x2, x3, f0, f1, f2, f3, tweps; integer s; x:= x1:= a; f1:= f; s:= sign (f1); tweps:= 2 * eps; start: if sign (b - a) != sign (dx) then goto exit; a:= x:= x2:= x1 + dx; if sign (x2 - b) = sign (x2 - x1) then a:= x:= x2:= b; f2:= f; if sign (f2) = s then begin x1:= x2; f1:= f2; goto start end; x0:= x1; f0:= f1; step: x:= x3:= (x1 * f2 - x2 * f1)/(f2 - f1); if sign(x3 - x0)= sign(x3 - x2) then begin x1:= x0; f1:= f0; goto step end; f3:= f; if f3 != 0 then begin if sign(f3) = s then begin x0:= x2; f0:= f2; s:= -s end; if comp(x3, x2, eta) > tweps then begin x1:= x2; f1:= f2; x2:= x3; f2:= f3; goto step end; if comp (x3, x0, eta) <= tweps then goto klaar; x:= x3; next: x:= x + tweps * sign (x0 - x3) * (if abs (x3) > eta then x3 else eta); f2:= f; if f3 * f2 >= 0 then begin x3:= x; f3:= f2; goto next end; x0:= x; klaar: zero 1:= (x0 + x3)/2 end else zero 1:= x3 end zero 1; real procedure comp(a,b,c); value a,b,c; real a,b,c; begin a:= abs(a); b:= abs(b); if a>b then begin if a>c then comp:= 1 - b/a else comp:=(a - b)/c end else if b>c then comp:= 1 - a/b else comp:=(b - a)/c end comp; real procedure bin (a, b); value a, b; integer a, b; begin integer i; real c; c:= 1; if 2 * b > a then b:= a - b; for i:= 1 step 1 until b do c:= (a - i + 1) * c/i; bin:= c end bin; for Z:= 6, 8 do begin integer i; for i:= 0 step 1 until 6 do begin real a, b, ETc, lnETc, ET, lnET, x, y, D, S, SIGMA, E; integer n, beta; real array alpha, coeff, gamma, omega, sigma[0 : Z], c1, c2[1 : Z - 1]; procedure calc 1; begin lnET:= 100 * lnETc / beta; ET:= exp (lnET); NLCR; print (-1/lnET); for n:= 0 step 1 until Z do alpha[n]:= bin (Z, n) * ET ** (n * (1 - a * n)) end calc 1; procedure calc 2; begin for n:= 0 step 1 until Z do sigma[n]:= (gamma[Z - n] + omega[n]) / (D * Z); SIGMA:= 2 * SUM (n, 0, Z, n * sigma[n]) - 1; print (SIGMA); E:= Z * lnETc * SUM (n, 0, Z, (Z - n) * (1 - a * (Z - n)) * sigma[n]); print (E) end calc 2; AA: a:= 0.12 * i/Z; for n:= 1 step 1 until Z - 1 do begin c1[n]:= (2 * n - Z + 2) * bin (Z - 1, n); c2[n]:= n * (1 - a * (2 + n)) end; b:= 0; ETc:= zero 1 (y, b, .125, 1, 2 - Z + SUM (n, 1, Z - 1, c1[n] * y ** c2[n]), SS, '-6, 1); lnETc:= ln (ETc); NLCR; print (Z); print (a); print (-1/lnETc); NLCR; S1: for beta:= 30, 40, 50 step 5 until 75, 80 step 2 until 88, 90 step 1 until 99 do begin real procedure poly (v); value v; real v; begin real pol; pol:= coeff[Z]; for n:= Z - 1 step -1 until 0 do pol:= pol * v + coeff[n]; poly:= pol end poly; calc 1; for n:= 0 step 1 until Z do coeff[n]:= n * alpha[n] - (Z - n) * alpha [Z - n]; b:= 0; x:= zero 1 (y, b, .5 - .5 * y, 1, poly (y), SS, '-6, 1); print (x); for n:= 0 step 1 until Z do begin real p; p:= x ** n; gamma[n]:= alpha[n] * p; omega[n]:= alpha[Z - n] * p end; D:= SUM (n, 0, Z, gamma[n] + omega[n]); S:= SUM (n, 0, Z, gamma[n] - omega [n]) / D; print (S); calc 2 end S1; NLCR; S2: for beta:= 100 step 10 until 200 do begin calc 1; TAB; TAB; for n:= 0 step 1 until Z do begin gamma[n]:= alpha[n]; omeeee