miércoles, 23 de enero de 2008

Cálculo de raices únicas reales en lenguaje TurboPascal

Desarrolle en TurboPascal una función que lleve a cabo el cálculo de las raíces únicas reales de una función continua en un intervalo cerrado [a,b] mediante el método de la bisección con una precisión delta -se supone que la longitud del intervalo es múltiplo de delta.

Para ello realice una función llamada raices que tenga como parámetros una función de reales en reales, dos reales que establezcan el intervalo de cálculo, un delta de precisión, y un vector con las soluciones, y que devuelva un entero indicando el número de raíces encontradas. Pruebe esta función creando un programa principal que muestre las raíces en el intervalo [-10,10] de las siguientes funciones matemáticas de reales en reales que también deberá implementar:
f1(x) = x2+x-12
f2(x) = x2-3x+2
f3(x) = x2-2x
f4(x)=sen(x)/(x+11) {seno en radianes}



{
El problema se puede resolver considerando pares de valores
f(xi) y f(xi+1) con i desde 1 hasta n-1, donde x1=linf, xn=lsup
y xi+1=xi+épsilon, siendo épsilon=100*delta. Para determinar los
pasos por cero de la función (raíces) se deben tratar los subintervalos
[xk, xk+1] para los que los signos de f(xk) y f(xk+1) sean distintos.
En dichos intervalos se debe buscar un valor de x para el que f(x) sea
igual o aproximado a cero. Esta búsqueda se realiza subdividiendo el
intervalo actual en dos de igual tamaño, y escogiendo aquél en el que
los valores de la función en los extremos del intervalo tengan distinto
signo. Este proceso se repite hasta que el valor de la función en el
centro del intervalo sea 0, o el tamaño del intervalo sea inferior a la
precisión requerida (delta). En ambos casos se debe devolver el punto
medio del intervalo.
}


{$F+}
uses crt;

Type TipoVector = array[1..10] of real;

TipoFun = function (R:Real):Real;

function f1(x:real):real; begin f1 := x*x + x - 12; end;

function f2(x:real):real; begin f2 := x*x -3*x + 2; end;

function f3(x:real):real; begin f3 := x*x -2*x; end;

function f4(x:real):real; begin f4 := sin(x)/(x+11); end;

function Raices(f:TipoFun;linf,lsup,delta:real;
var soluciones:TipoVector):integer;
var
x : real;
i : real;
nraices : integer;
y : real;
paso : real;
inf,sup,medio,limite:real;
begin
nraices :=0;
{en caso de que los limites esten invertidos los cambio}
if linf > lsup then
begin
i:=linf;
linf:=lsup;
lsup:=i;
end;

y := linf ;
paso := delta*100;
while y < lsup do
begin
if ( abs( f(y) ) < delta ) then
begin
nraices := nraices + 1;
soluciones[nraices]:=y;
y:=y+paso;
end
else
begin
if ((f(y)*f(y+paso))<0) then
begin
nraices := nraices + 1;
inf := y;
sup := y+paso;
medio := (y+(y+paso))/2;
limite:= medio - inf;
while ( (limite>delta) and (f(medio)<>0) ) do
begin
if (f(inf)*f(medio)<0) then
sup := medio
else
inf := medio;
medio := (sup + inf)/2;
limite := medio - inf;
end;
soluciones[nraices]:=medio;
end;
y:=y+paso;
end;
end;
if ( abs( f(lsup) ) < delta ) then
begin
nraices := nraices + 1;
soluciones[nraices]:=sup;
end;
Raices := nraices;
end;


var
nsol : integer;
x,linf,lsup,ti : real;
Sol : TipoVector;
i : integer;
begin
clrscr;
{ Peticion de los parametros }
write('Dame el limite inferior : '); readln(linf);
write('Dame el limite superior : '); readln(lsup);
write('Dame el rango de subdivision : '); readln(ti);
{Calculo de las raices para cada una de las cuatro funciones }
nsol := Raices(f1,linf,lsup,ti,Sol);
writeln('Funcion 1. Numero de Soluciones : ', nsol);
for i := 1 to nsol do
begin
writeln('Solucion ',i,' : ',Sol[i]);
end;

nsol := Raices(f2,linf,lsup,ti,Sol);
writeln('Funcion 2. Numero de Soluciones : ', nsol);
for i := 1 to nsol do
begin
writeln('Solucion ',i,' : ',Sol[i]);
end;

nsol := Raices(f3,linf,lsup,ti,Sol);
writeln('Funcion 3. Numero de Soluciones : ', nsol);
for i := 1 to nsol do
begin
writeln('Solucion ',i,' : ',Sol[i]);
end;

nsol := Raices(f4,linf,lsup,ti,Sol);
writeln('Funcion 4. Numero de Soluciones : ', nsol);
for i := 1 to nsol do
begin
writeln('Solucion ',i,' : ',Sol[i]);
end;

{Se para un momento para la visualizacion de los resultados}
write('Pulsa una tecla...');
Readkey;
end.

No hay comentarios: