listati con turbo pascal per bisezione (varianti)
bis4a bis5a bis6a bis7a bis8a bis9a bis11a bis12a
program bis4a;
(* calcola valori funzione entro campo da assegnare *)
(* scelta estremi sinistro e destro tra valori calcolati sopra *)
(* cerca radice approssimata dopo n bisezioni da indicare *)
uses crt;
var a,b,medio,x,y:real;
k,n,t:integer;
function f1(x:real):real;
begin
f1:=-7*x+2*exp(-3*x)-1;
end;
function f2(x:real):real;
begin
f2:=2*sqrt(x)-3*exp(-x);
end;
function f3(x:real):real;
begin
f3:=2*exp(-x)+2*x*x-3;
end;
function f4(x:real):real;
begin
f4:=2*sqrt(x)+3*x-1;
end;
function f5(x:real):real;
begin
f5:=3*sin(x)/cos(x)+x-1;
end;
procedure uscita;
begin
writeln('funzione sempre con stesso segno:riprova o esci');
writeln('premi enter ');readln;readln;
halt;
end;
procedure vedi(es,ed:real);
begin
for k:=1 to n do
begin
medio:=(es+ed)/2;
if t=1 then if f1(es)*f1(medio)<=0 then ed:=medio else es:=medio
else
if t=2 then if f2(es)*f2(medio)<=0 then ed:=medio else es:=medio
else
if t=3 then if f3(es)*f3(medio)<=0 then ed:=medio else es:=medio
else
if t=4 then if f4(es)*f4(medio)<=0 then ed:=medio else es:=medio
else
if t=5 then if f5(es)*f5(medio)<=0 then ed:=medio else es:=medio
end;
writeln('radice approssimata:',medio:0:8);
WRITELN('premi enter per proseguire');
READLN;
end;
procedure calcola (es,ed:real);
begin
clrscr;
vedi(es,ed);
end;
procedure leggi_dati;
begin
gotoxy(45,13);write('estremo sinistro =');read(a);
gotoxy(45,14);write('estremo destro =');read(b);
if a=100 then uscita;
gotoxy(45,16);write('numero iterazioni :prova 20..=');readln(n);
calcola(a,b);
end;
procedure prova;
var g,h,k:integer;
begin
clrscr;
write('scrivi valore iniziale per calcolo funzione:');readln(g);
write('scrivi valore finale per calcolo funzione :');readln(h);
writeln('...scegli estremo sinistro e destro per calcolo radice ');
writeln('...scrivi 100..100 se funzione sempre con stesso segno,o per FINE ');
case t of
1:begin for k:=g to h do writeln('per x=',K:8,'...f(x)=',f1(k):8:6);end;
2:begin for k:=g to h do writeln('per x=',K:8,'...f(x)=',f2(k):8:6);end;
3:begin for k:=g to h do writeln('per x=',K:8,'...f(x)=',f3(k):8:6);end;
4:begin for k:=g to h do writeln('per x=',K:8,'...f(x)=',f4(k):8:6);end;
5:begin for k:=g to h do writeln('per x=',K:8,'...f(x)=',f5(k):8:6);end;
end;
leggi_dati;
end;
procedure scelta;
var ancora:integer;
begin
clrscr;
writeln('funzioni memorizzate da provare ');
writeln('1...f1:=-7x+2e(-3x)-1');
writeln('2...f2:=2*sqrt(x)-3e(-x).SOLO VALORI POSITIVI o ZERO;');
writeln('3...f3:=2*e(-x)+2x^2-3');
writeln('4...f4:=2sqrt(x)+3x-1 ....SOLO VALORI POSITIVI o ZERO;');
writeln('5.. f5:=3sin(x)/cos(x)+x-1');
writeln('----------------------------------');
write('indica funzione da provare 1,2,3,4,5.');readln(t);
prova;
WRITELN('-------------------------------');
write('altra prova:scrivi 1...fine:scrivi 2 ');readln(ancora);
if ancora=1 then scelta;
end;
begin
clrscr;
scelta;
writeln('premi enter');
readln;
end.
program bis5a;
(* calcola valori funzione entro campo da assegnare *)
(* scelta estremi sinistro e destro tra valori calcolati sopra *)
(* cerca radice approssimata dopo n bisezioni da indicare *)
(* stampa valori funzioni calcolati per x variabile *)
uses crt;
var a,b,medio,x:real;
k,n,t:integer;
y1,y2,y3,y4,y5:string;
function f1(x:real):real;
begin
f1:=-7*x+2*exp(-3*x)-1;
end;
function f2(x:real):real;
begin
f2:=2*sqrt(x)-3*exp(-x);
end;
function f3(x:real):real;
begin
f3:=2*exp(-x)+2*x*x-3;
end;
function f4(x:real):real;
begin
f4:=2*sqrt(x)+3*x-1;
end;
function f5(x:real):real;
begin
f5:=3*sin(x)/cos(x)+x-1;
end;
procedure uscita;
begin
writeln('funzione sempre con stesso segno:riprova o esci');
writeln('premi enter ');readln;readln;
halt;
end;
procedure vedi(es,ed:real);
begin
for k:=1 to n do
begin
medio:=(es+ed)/2;
if t=1 then begin if f1(es)*f1(medio)<=0 then ed:=medio else es:=medio;
writeln('f(s)=',f1(es):10:6,'..f(d)=',f1(medio):10:6);end
else
if t=2 then BEGIN if f2(es)*f2(medio)<=0 then ed:=medio else es:=medio;
writeln('f(s)=',f2(es):10:6,'..f(d)=',f2(medio):10:6);end
else
if t=3 then BEGIN if f3(es)*f3(medio)<=0 then ed:=medio else es:=medio;
writeln('f(s)=',f3(es):10:6,'..f(d)=',f3(medio):10:6);end
else
if t=4 then BEGIN if f4(es)*f4(medio)<=0 then ed:=medio else es:=medio;
writeln('f(s)=',f4(es):10:6,'..f(d)=',f4(medio):10:6);end
else
if t=5 then BEGIN if f5(es)*f5(medio)<=0 then ed:=medio else es:=medio;
writeln('f(s)=',f5(es):10:6,'..f(d)=',f5(medio):10:6);end;
writeln('sinistro=',es:10:6,'..destro=',ed:10:6,'..medio=',medio:10:6);
WRITELN('-------------------------------------------------------');
end;
writeln('radice approssimata:',medio:0:8);
WRITELN('premi enter per proseguire');
READLN;
end;
procedure leggi_dati;
begin
gotoxy(45,13);write('estremo sinistro =');read(a);
gotoxy(45,14);write('estremo destro =');read(b);
if a=100 then uscita;
gotoxy(45,16);write('numero iterazioni :prova 20..=');readln(n);
vedi(a,b);
end;
procedure prova;
var g,h,k:integer;
begin
clrscr;
case t of
1:writeln(y1);
2:writeln(y2);
3:writeln(y3);
4:writeln(y4);
5:writeln(y5);
end;
write('scrivi valore iniziale per calcolo funzione:');readln(g);
write('scrivi valore finale per calcolo funzione :');readln(h);
writeln('...scegli estremo sinistro e destro per calcolo radice ');
writeln('...scrivi 100..100 se funzione sempre con stesso segno,o per FINE ');
case t of
1:begin for k:=g to h do writeln('per x=',K:8,'...f(x)=',f1(k):8:6);end;
2:begin for k:=g to h do writeln('per x=',K:8,'...f(x)=',f2(k):8:6);end;
3:begin for k:=g to h do writeln('per x=',K:8,'...f(x)=',f3(k):8:6);end;
4:begin for k:=g to h do writeln('per x=',K:8,'...f(x)=',f4(k):8:6);end;
5:begin for k:=g to h do writeln('per x=',K:8,'...f(x)=',f5(k):8:6);end;
end;
leggi_dati;
end;
procedure scelta;
var ancora:integer;
begin
clrscr;
y1:='f1:=-7x+2e(-3x)-1';
y2:='f2:=2*sqrt(x)-3e(-x) SOLO VALORI POSITIVI o ZERO';
y3:='f3:=2*e(-x)+2x^2-3';
y4:='f4:=2sqrt(x)+3x-1 ....SOLO VALORI POSITIVI o ZERO';
y5:='f5:=3sin(x)/cos(x)+x-1';
writeln('funzioni memorizzate da provare ');
writeln('1.',y1);
writeln('2.',y2);
writeln('3.',y3);
writeln('4.',y4);
writeln('5.',y5);
writeln('----------------------------------');
write('indica funzione da provare 1,2,3,4,5.');readln(t);
prova;
WRITELN('-------------------------------');
write('altra prova:scrivi 1...fine:scrivi 2 ');readln(ancora);
if ancora=1 then scelta;
end;
begin
clrscr;
scelta;
writeln('premi enter');
readln;
end.
program bis6a;
(* calcola valori funzione entro campo da assegnare *)
(* scelta estremi sinistro e destro tra valori calcolati sopra *)
(* cerca radice approssimata dopo n bisezioni da indicare *)
(* stampa valori funzioni calcolati per x variabile *)
uses crt;
var a,b,medio,x,y:real;
k,n,t,pausa:integer;
function f1(x:real):real;
begin
f1:=-7*x+2*exp(-3*x)-1;
end;
function f2(x:real):real;
begin
f2:=2*sqrt(x)-3*exp(-x);
end;
function f3(x:real):real;
begin
f3:=2*exp(-x)+2*x*x-3;
end;
function f4(x:real):real;
begin
f4:=2*sqrt(x)+3*x-1;
end;
function f5(x:real):real;
begin
f5:=3*sin(x)/cos(x)+x-1;
end;
procedure uscita;
begin
writeln('funzione sempre con stesso segno:riprova o esci');
writeln('premi enter ');readln;readln;
halt;
end;
procedure vedi(es,ed:real);
begin
for k:=1 to n do
begin
medio:=(es+ed)/2;
if t=1 then begin if f1(es)*f1(medio)<=0 then ed:=medio else es:=medio;
writeln('sinistro=',es:10:6,'..destro=',ed:10:6,'..medio=',medio:10:6);
writeln('f(s)=',f1(es):10:6,'..f(d)=',f1(medio):10:6);end
else
if t=2 then BEGIN if f2(es)*f2(medio)<=0 then ed:=medio else es:=medio;
writeln('sinistro=',es:10:6,'..destro=',ed:10:6,'..medio=',medio:10:6);
writeln('f(s)=',f2(es):10:6,'..f(d)=',f2(medio):10:6);end
else
if t=3 then BEGIN if f3(es)*f3(medio)<=0 then ed:=medio else es:=medio;
writeln('sinistro=',es:10:6,'..destro=',ed:10:6,'..medio=',medio:10:6);
writeln('f(s)=',f3(es):10:6,'..f(d)=',f3(medio):10:6);end
else
if t=4 then BEGIN if f4(es)*f4(medio)<=0 then ed:=medio else es:=medio;
writeln('sinistro=',es:10:6,'..destro=',ed:10:6,'..medio=',medio:10:6);
writeln('f(s)=',f4(es):10:6,'..f(d)=',f4(medio):10:6);end
else
if t=5 then BEGIN if f5(es)*f5(medio)<=0 then ed:=medio else es:=medio;
writeln('sinistro=',es:10:6,'..destro=',ed:10:6,'..medio=',medio:10:6);
writeln('f(s)=',f5(es):10:6,'..f(d)=',f5(medio):10:6);end ;
WRITELN;
IF pausa=1 then begin write('premi ENTER');readln;end;
end;
writeln('radice approssimata:',medio:0:8);
WRITELN('premi enter per proseguire');
READLN;
end;
procedure calcola (es,ed:real);
begin
clrscr;
vedi(es,ed);
end;
procedure leggi_dati;
begin
gotoxy(45,13);write('estremo sinistro =');read(a);
gotoxy(45,14);write('estremo destro =');read(b);
if a=100 then uscita;
gotoxy(45,16);write('numero iterazioni :prova 20..=');readln(n);
calcola(a,b);
end;
procedure prova;
var g,h,k:integer;
begin
clrscr;
write('scrivi valore iniziale per calcolo funzione:');readln(g);
write('scrivi valore finale per calcolo funzione :');readln(h);
writeln('...scegli estremo sinistro e destro per calcolo radice ');
writeln('...scrivi 100..100 se funzione sempre con stesso segno,o per FINE ');
case t of
1:begin for k:=g to h do writeln('per x=',K:8,'...f(x)=',f1(k):8:6);end;
2:begin for k:=g to h do writeln('per x=',K:8,'...f(x)=',f2(k):8:6);end;
3:begin for k:=g to h do writeln('per x=',K:8,'...f(x)=',f3(k):8:6);end;
4:begin for k:=g to h do writeln('per x=',K:8,'...f(x)=',f4(k):8:6);end;
5:begin for k:=g to h do writeln('per x=',K:8,'...f(x)=',f5(k):8:6);end;
end;
leggi_dati;
end;
procedure scelta;
var ancora:integer;
begin
clrscr;
writeln('funzioni memorizzate da provare ');
writeln('1...f1:=-7x+2e(-3x)-1');
writeln('2...f2:=2*sqrt(x)-3e(-x).SOLO VALORI POSITIVI o ZERO;');
writeln('3...f3:=2*e(-x)+2x^2-3');
writeln('4...f4:=2sqrt(x)+3x-1 ....SOLO VALORI POSITIVI o ZERO;');
writeln('5.. f5:=3sin(x)/cos(x)+x-1');
writeln('----------------------------------');
write('indica funzione da provare 1,2,3,4,5.');readln(t);
write('scrivi 1 per pausa durante visualizzazione..0=senza pausa');
readln(pausa);
prova;
WRITELN('-------------------------------');
write('altra prova:scrivi 1...fine:scrivi 2 ');readln(ancora);
if ancora=1 then scelta;
end;
begin
clrscr;
scelta;
writeln('premi enter');
readln;
end.
program bis7a;
(* calcola valori funzione entro campo da assegnare *)
(* scelta estremi sinistro e destro tra valori calcolati sopra *)
(* cerca radice approssimata dopo n bisezioni da indicare *)
(* stampa valori funzioni calcolati per x variabile *)
uses crt;
var a,b,medio,x,y:real;
k,n,t,pausa:integer;
function f1(x:real):real;
begin
f1:=-7*x+2*exp(-3*x)-1;
end;
function f2(x:real):real;
begin
f2:=2*sqrt(x)-3*exp(-x);
end;
function f3(x:real):real;
begin
f3:=2*exp(-x)+2*x*x-3;
end;
function f4(x:real):real;
begin
f4:=2*sqrt(x)+3*x-1;
end;
function f5(x:real):real;
begin
f5:=3*sin(x)/cos(x)+x-1;
end;
procedure uscita;
begin
writeln('funzione sempre con stesso segno:riprova o esci');
writeln('premi enter ');readln;readln;
halt;
end;
procedure vedi(es,ed:real);
begin
for k:=1 to n do
begin
medio:=(es+ed)/2;
if t=1 then begin if f1(es)*f1(medio)<=0 then ed:=medio else es:=medio;
writeln('f(s)=',f1(es):10:6,'..f(d)=',f1(medio):10:6);end
else
if t=2 then BEGIN if f2(es)*f2(medio)<=0 then ed:=medio else es:=medio;
writeln('f(s)=',f2(es):10:6,'..f(d)=',f2(medio):10:6);end
else
if t=3 then BEGIN if f3(es)*f3(medio)<=0 then ed:=medio else es:=medio;
writeln('f(s)=',f3(es):10:6,'..f(d)=',f3(medio):10:6);end
else
if t=4 then BEGIN if f4(es)*f4(medio)<=0 then ed:=medio else es:=medio;
writeln('f(s)=',f4(es):10:6,'..f(d)=',f4(medio):10:6);end
else
if t=5 then BEGIN if f5(es)*f5(medio)<=0 then ed:=medio else es:=medio;
writeln('f(s)=',f5(es):10:6,'..f(d)=',f5(medio):10:6);end ;
writeln('sinistro=',es:10:6,'..destro=',ed:10:6,'..medio=',medio:10:6);
WRITELN('------------------------------------------------------------');
IF pausa=1 then begin write('premi ENTER');readln;end;
end;
writeln('radice approssimata:',medio:0:8);
WRITELN('premi enter per proseguire');
READLN;
end;
procedure calcola (es,ed:real);
begin
clrscr;
vedi(es,ed);
end;
procedure leggi_dati;
begin
gotoxy(45,13);write('estremo sinistro =');read(a);
gotoxy(45,14);write('estremo destro =');read(b);
if a=100 then uscita;
gotoxy(45,16);write('numero iterazioni :prova 20..=');readln(n);
calcola(a,b);
end;
procedure prova;
var g,h,k:integer;
begin
clrscr;
write('scrivi valore iniziale per calcolo funzione:');readln(g);
write('scrivi valore finale per calcolo funzione :');readln(h);
writeln('...scegli estremo sinistro e destro per calcolo radice ');
writeln('...scrivi 100..100 se funzione sempre con stesso segno,o per FINE ');
case t of
1:begin for k:=g to h do writeln('per x=',K:8,'...f(x)=',f1(k):8:6);end;
2:begin for k:=g to h do writeln('per x=',K:8,'...f(x)=',f2(k):8:6);end;
3:begin for k:=g to h do writeln('per x=',K:8,'...f(x)=',f3(k):8:6);end;
4:begin for k:=g to h do writeln('per x=',K:8,'...f(x)=',f4(k):8:6);end;
5:begin for k:=g to h do writeln('per x=',K:8,'...f(x)=',f5(k):8:6);end;
end;
leggi_dati;
end;
procedure scelta;
var ancora:integer;
begin
clrscr;
writeln('funzioni memorizzate da provare ');
writeln('1...f1:=-7x+2e(-3x)-1');
writeln('2...f2:=2*sqrt(x)-3e(-x).SOLO VALORI POSITIVI o ZERO;');
writeln('3...f3:=2*e(-x)+2x^2-3');
writeln('4...f4:=2sqrt(x)+3x-1 ....SOLO VALORI POSITIVI o ZERO;');
writeln('5.. f5:=3sin(x)/cos(x)+x-1');
writeln('----------------------------------');
write('indica funzione da provare 1,2,3,4,5.');readln(t);
write('scrivi 1 per pausa durante visualizzazione..0=senza pausa');
readln(pausa);
prova;
WRITELN('-------------------------------');
write('altra prova:scrivi 1...fine:scrivi 2 ');readln(ancora);
if ancora=1 then scelta;
end;
begin
clrscr;
scelta;
writeln('premi enter');
readln;
end.
program bis8a;
(* calcola valori funzione entro campo da assegnare *)
(* scelta estremi sinistro e destro tra valori calcolati sopra *)
(* cerca radice approssimata dopo n bisezioni da indicare *)
(* stampa valori funzioni calcolati per x variabile *)
uses crt;
var a,b,medio,x,y:real;
k,n,t,pausa:integer;
function f1(x:real):real;
begin
f1:=-7*x+2*exp(-3*x)-1;
end;
function f2(x:real):real;
begin
f2:=2*sqrt(x)-3*exp(-x);
end;
function f3(x:real):real;
begin
f3:=2*exp(-x)+2*x*x-3;
end;
function f4(x:real):real;
begin
f4:=2*sqrt(x)+3*x-1;
end;
function f5(x:real):real;
begin
f5:=3*sin(x)/cos(x)+x-1;
end;
procedure uscita;
begin
writeln('funzione sempre con stesso segno:riprova o esci');
writeln('premi enter ');readln;readln;
halt;
end;
procedure vedi(es,ed:real);
begin
for k:=1 to n do
begin
medio:=(es+ed)/2;
case t of
1: begin if f1(es)*f1(medio)<=0 then ed:=medio else es:=medio;
writeln('f(s)=',f1(es):10:6,'..f(d)=',f1(medio):10:6);end;
2:BEGIN if f2(es)*f2(medio)<=0 then ed:=medio else es:=medio;
writeln('f(s)=',f2(es):10:6,'..f(d)=',f2(medio):10:6);end;
3:BEGIN if f3(es)*f3(medio)<=0 then ed:=medio else es:=medio;
writeln('f(s)=',f3(es):10:6,'..f(d)=',f3(medio):10:6);end;
4:BEGIN if f4(es)*f4(medio)<=0 then ed:=medio else es:=medio;
writeln('f(s)=',f4(es):10:6,'..f(d)=',f4(medio):10:6);end;
5:BEGIN if f5(es)*f5(medio)<=0 then ed:=medio else es:=medio;
writeln('f(s)=',f5(es):10:6,'..f(d)=',f5(medio):10:6);end ;
END;
writeln('sinistro=',es:10:6,'..destro=',ed:10:6,'..medio=',medio:10:6);
WRITELN('------------------------------------------------------------');
IF pausa=1 then begin write('premi ENTER');readln;end;
end;
writeln('radice approssimata:',medio:0:8);
WRITELN('premi enter per proseguire');
READLN;
end;
procedure leggi_dati;
begin
gotoxy(45,13);write('estremo sinistro =');read(a);
gotoxy(45,14);write('estremo destro =');read(b);
if a=100 then uscita;
gotoxy(45,16);write('numero iterazioni :prova 20..=');readln(n);
vedi(a,b);
end;
procedure prova;
var g,h,k:integer;
begin
WRITELN('---------------------------------------------------------------');
WRITELN('...prima si cercano valori della funzione entro campo assegnato');
WRITELN('...prendere nota dei valori ove la funzione cambia segno ');
WRITELN('...se la funzione cambia segno,annotare valori variabile ');
writeln('...scegli estremo sinistro e destro per calcolo radice ');
writeln('...scrivi 100..100 se funzione sempre con stesso segno,o per FINE ');
WRITELN('----------------------------------------------------------------');
write('scrivi valore iniziale per calcolo funzione:');readln(g);
write('scrivi valore finale per calcolo funzione :');readln(h);
writeln('premi enter');READLN;clrscr;
case t of
1:begin for k:=g to h do writeln('per x=',K:8,'...f(x)=',f1(k):8:6);end;
2:begin for k:=g to h do writeln('per x=',K:8,'...f(x)=',f2(k):8:6);end;
3:begin for k:=g to h do writeln('per x=',K:8,'...f(x)=',f3(k):8:6);end;
4:begin for k:=g to h do writeln('per x=',K:8,'...f(x)=',f4(k):8:6);end;
5:begin for k:=g to h do writeln('per x=',K:8,'...f(x)=',f5(k):8:6);end;
end;
leggi_dati;
end;
procedure scelta;
var ancora:integer;
begin
clrscr;
writeln('funzioni memorizzate da provare ');
writeln('1...f1:=-7x+2e(-3x)-1');
writeln('2...f2:=2*sqrt(x)-3e(-x).SOLO VALORI POSITIVI o ZERO;');
writeln('3...f3:=2*e(-x)+2x^2-3');
writeln('4...f4:=2sqrt(x)+3x-1 ....SOLO VALORI POSITIVI o ZERO;');
writeln('5.. f5:=3sin(x)/cos(x)+x-1');
writeln('----------------------------------');
write('indica funzione da provare 1,2,3,4,5.');readln(t);
write('scrivi 1 per pausa durante visualizzazione..0=senza pausa');
readln(pausa);
prova;
WRITELN('-------------------------------');
write('altra prova:scrivi 1...fine:scrivi 2 ');readln(ancora);
if ancora=1 then scelta;
end;
begin
clrscr;
scelta;
writeln('premi enter');
readln;
end.
program bis9a;
(* calcola valori funzione entro campo da assegnare *)
(* scelta estremi sinistro e destro tra valori calcolati sopra *)
(* cerca radice approssimata dopo n bisezioni da indicare *)
(* stampa valori funzioni calcolati per x variabile *)
uses crt;
var a,b,medio,x:real;
k,n,pausa:integer;
function f1(x:real):real;
begin
f1:=-7*x+2*exp(-3*x)-1; (* funzione da inserire,poi RUN *)
(* f1:=x*x*-5*x-2 *)
end;
procedure uscita;
begin
writeln('funzione sempre con stesso segno:riprova o esci');
writeln('premi enter ');readln;readln;
halt;
end;
procedure vedi(es,ed:real);
begin
for k:=1 to n do
begin
medio:=(es+ed)/2;
if f1(es)*f1(medio)<=0 then ed:=medio else es:=medio;
writeln('f(s)=',f1(es):10:6,'..f(d)=',f1(medio):10:6);
writeln('sinistro=',es:10:6,'..destro=',ed:10:6,'..medio=',medio:10:6);
WRITELN('------------------------------------------------------------');
IF pausa=1 then begin write('bisezione n.',k,' su ',n,'..premi ENTER');
readln;end;
end;
writeln('radice approssimata:',medio:0:8);
WRITELN('premi enter per proseguire');
READLN;
end;
procedure leggi_dati;
begin
gotoxy(45,13);write('estremo sinistro =');read(a);
gotoxy(45,14);write('estremo destro =');read(b);
if a=100 then uscita;
gotoxy(45,16);write('numero iterazioni :prova 20..=');readln(n);
vedi(a,b);
end;
procedure prova;
var g,h,k:integer;
begin
WRITELN('---------------------------------------------------------------');
WRITELN('...prima si cercano valori della funzione entro campo assegnato');
WRITELN('...prendere nota dei valori ove la funzione cambia segno ');
WRITELN('...se la funzione cambia segno,annotare valori variabile ');
writeln('...scegli estremo sinistro e destro per calcolo radice ');
writeln('...scrivi 100..100 se funzione sempre con stesso segno,o per FINE ');
WRITELN('----------------------------------------------------------------');
write('scrivi valore iniziale per calcolo funzione:');readln(g);
write('scrivi valore finale per calcolo funzione :');readln(h);
writeln('premi enter');READLN;clrscr;
for k:=g to h do begin writeln('per x=',K:8,'...f(x)=',f1(k):8:6);end;
leggi_dati;
end;
procedure scelta;
var ancora:integer;
begin
clrscr;
writeln('funzioni memorizzate da provare ');
writeln('f1:=-7x+2e(-3x)-1');
write('scrivi 1 per pausa durante visualizzazione..0=senza pausa..');
readln(pausa);
prova;
WRITELN('-------------------------------');
write('altra prova:scrivi 1...fine:scrivi 2 ');readln(ancora);
if ancora=1 then scelta;
end;
begin
clrscr;
scelta;
writeln('premi enter');
readln;
end.
program bis11a;
(* calcola valori funzione entro campo da assegnare *)
(* scelta automatica estremi sinistro e destro tra valori calcolati sopra *)
(* cerca radice approssimata dopo n bisezioni da indicare *)
(* stampa valori funzioni calcolati per x variabile *)
uses crt;
var a,b,medio,x:real;
k,n,pausa:integer;
y:string;
function f1(x:real):real;
begin
f1:=-7*x+2*exp(-3*x)-1;
(* funzione da inserire,poi RUN *)
(* cambiare funzione anche in y..SCELTA *)
(* f1:=x*x*-5*x-2 *)
(* f1:=-7*x+2*exp(-3*x)-1 *)
end;
procedure uscita;
begin
writeln('funzione sempre con stesso segno:riprova');
writeln('premi enter ');readln;
halt;
end;
procedure vedi(es,ed:real);
begin
for k:=1 to n do
begin
medio:=(es+ed)/2;
if f1(es)*f1(medio)<=0 then ed:=medio else es:=medio;
writeln('f(s)=',f1(es):10:6,'..f(d)=',f1(medio):10:6);
writeln('sinistro=',es:10:6,'..destro=',ed:10:6,'..medio=',medio:10:6);
WRITELN('------------------------------------------------------------');
IF pausa=1 then begin write('BISEZIONE n.',k,' su ',n,'..premi ENTER');
readln;end;
end;
writeln('-------------------------------------------------------------');
writeln('radice approssimata:',medio:0:8);
WRITELN('premi enter per proseguire');
READLN;
end;
procedure prova;
var g,h,k:integer;
begin
WRITELN('---------------------------------------------------------------');
WRITELN('...prima si cercano valori della funzione entro campo assegnato');
WRITELN('...poi il programma cerca primi valori funzioni discordi ');
WRITELN('...quindi assegna campo per ricerca radice approssimata ');
WRITELN('----------------------------------------------------------------');
write('scrivi valore iniziale per calcolo funzione:');readln(g);
write('scrivi valore finale per calcolo funzione :');readln(h);
write('scrivi numero bisezioni da eseguire :20....:');readln(n);
writeln('premi enter');READLN;clrscr;
for k:=g to h do
begin
writeln('per x=',K:8,'...f(x)=',f1(k):12:6);
if f1(k)*f1(k-1)<=0 then vedi(k-1,k);end;
if f1(k)*f1(k-1)>0 then uscita;
end;
procedure scelta;
var ancora:integer;
begin
clrscr;
writeln('funzioni memorizzate da provare ');
y:='-7x+2e(-3x)-1'; (* funzione da cambiare *)
writeln(y);
write('scrivi 1 per pausa durante visualizzazione..0=senza pausa..');
readln(pausa);
prova;
WRITELN('-------------------------------');
write('altra prova:scrivi 1...fine:scrivi 2 ');readln(ancora);
if ancora=1 then scelta;
end;
begin
clrscr;
scelta;
writeln('premi enter');
readln;
end.
program bis12a;
(* calcola valori funzione entro campo da assegnare *)
(* scelta estremi sinistro e destro tra valori calcolati sopra *)
(* cerca radice approssimata dopo n bisezioni da indicare *)
(* ricerca radice tra estemi con passo da indicare *)
(* stampa valori funzioni calcolati per x variabile *)
uses crt;
var a,b,medio,x:real;
k,n,pausa,sosta:integer;
y:string;
function f1(x:real):real;
begin
f1:=-7*x+2*exp(-3*x)-1;
(* funzione da inserire,poi RUN *)
(* cambiare funzione anche in y..SCELTA *)
(* f1:=x*x*-5*x-2 *)
(* f1:=-7*x+2*exp(-3*x)-1 *)
end;
procedure uscita;
begin
writeln('funzione sempre con stesso segno:riprova');
writeln('premi enter ');readln;
halt;
end;
procedure vedi(es,ed:integer);
var passo,z:real;
p,opzione:integer;
begin
writeln('estremi entro i quali cercare radice ',es:12,ed:12);
writeln('assegna passo per ricerca..0.1 0.01 0.001 ');readln(passo);
writeln('scrivi numero valori da provare..10...20..30..');readln(n);
writeln('scrivi 1 per vedere singoli risultati,oppure 2 ');readln(sosta);
z:=es;
writeln('osserva valore funzione che cambia segno per trovare radice');
writeln('se non cambia segno,prova con altro passo,altro numero valori ');
WRITELN('premi enter');READLN;
clrscr;
for p:=1 to n do
begin writeln('per x=',z:8:6,' f(x)=',f1(z):8:6);z:=z+passo;
if sosta=1 then begin readln end;end;
writeln('----------------------------------------------------------');
write('per altro passo scrivi 1..per fine scrivi 2 ');readln(opzione);
if opzione=1 then vedi(es,ed) else uscita;
end;
procedure prova;
var g,h,k:integer;
begin
WRITELN('---------------------------------------------------------------');
WRITELN('...prima si cercano valori della funzione entro campo assegnato');
WRITELN('...poi il programma cerca primi valori funzioni discordi ');
WRITELN('...quindi assegna campo per ricerca radice approssimata ');
WRITELN('----------------------------------------------------------------');
write('scrivi valore iniziale per calcolo funzione:');readln(g);
write('scrivi valore finale per calcolo funzione :');readln(h);
writeln('premi enter');READLN;clrscr;
for k:=g to h do
begin
writeln('per x=',K:8,'...f(x)=',f1(k):12:6);
if f1(k)*f1(k-1)<=0 then vedi(k-1,k);end;
if f1(k)*f1(k-1)>0 then uscita;
end;
procedure scelta;
var ancora:integer;
begin
clrscr;
writeln('funzioni memorizzate da provare ');
y:='-7x+2e(-3x)-1'; (* funzione da cambiare *)
writeln(y);
write('scrivi 1 per pausa durante visualizzazione..0=senza pausa..');
readln(pausa);
prova;
WRITELN('-------------------------------');
write('altra prova:scrivi 1...fine:scrivi 2 ');readln(ancora);
if ancora=1 then scelta;
end;
begin
clrscr;
scelta;
writeln('premi enter');
readln;
end.