Trabajo Practico 1

{Seccion declarativa}
 
program Fechas;
{programa que calcula el tiempo entre dos fechas}
{expresado en dias, meses y años}
{permite controlar cuanto tiempo trabajo un empleado}
 
{definicion de recursos}
 
uses
 
crt,dos;
 
 
var
di,mi,ai,de,me,ae:integer; {dia, mes y año de ingreso/egreso}
dt,mt,at:integer; {dias, meses y años trabajados}
dfeb:integer; {dias de febrero}
diasmi:integer; {dias del mes de ingreso}
diast,mesest,anost:char;
{seccion algoritmica}
 
begin
 
{ingreso de datos}                      
 
	clrscr;                 
	writeln('Hola, ingrese la fecha de ingreso con el siguiente formato y presione enter');
	writeln('dd mm aaaa');
	readln(di,mi,ai);
	writeln('muy bien, ahora ingrese la fecha de egreso del mismo modo y presione enter');
	readln(de,me,ae);
 
{resolucion}
 
	if (mi=2)
	then
       		if (ai mod 4=0)
       		then
          			if (ai mod 100=0) and (ai mod 400<>0)
           			then
           			dfeb:=28
           			else
           			dfeb:=29
       		else
       		dfeb:=28;
 
 
	at:=abs(ae-ai);
	mt:=abs(me-mi);
	dt:=abs(de-di)+1;
 
 
	if (mi>=me)
   	then
       		begin
           	at:=at-1;
           	mt:=(12-mi)+me;
           	if di>de
              		then
              		begin
              		mt:=mt-1;
              		case mi of
               			1,3,5,7,8,10,12:diasmi:=31;
               			2:diasmi:=dfeb;
               			4,6,9,11:diasmi:=30;
               		end;
 
               	dt:=(diasmi-di)+de+1;
             	end;
	end;
 
 
 
	if (di>de) then
           if (ai=ae) or (mi<me) then
   	   	begin
       		mt:=mt-1;
       		case mi of
       			 1,3,5,7,8,10,12:diasmi:=1;
               		 2:diasmi:=dfeb;
               		 4,6,9,11:diasmi:=30;
                end;
 
       		dt:=(diasmi-di)+de+1;
       end;
 
 
	if mt>=12
   	then
	begin
   		at:=at+1;
   		mt:=mt-12;
        end;
 
 
{epilogo}
{exhibicion de resultados}
 
	if at=0 then
           if mt=0 then
              begin
              clrscr;
              writeln('La persona en cuestion trabajo ',dt,' dia/s');
              readln;
              end
           else
              begin
              clrscr;
              writeln('La persona en cuestion trabajo ',dt,' dia/s y ',mt,' mes/es');
              readln;
              end
         else
             if mt=0 then
                begin
                clrscr;
                writeln('La persona en cuestion trabajo ',dt,' dia/s y ',at,' a¤o/s');
                readln;
                end
             else
                 begin
                 clrscr;
                 writeln('La persona en cuestion trabajo ',dt,' dia/s, ',mt,' mes/es y ',at,' a¤o/s');
                 readln;
          end
end.

{Seccion declarativa}
{Objetivo del programa}
   Program Calculo_de_raices;
   {El programa permite calcular las raices simples de la funcion
   f=a2x^2+a1x+a0 por metodo de aproximaciones sucesivas}
{Definicion de recursos}
   Uses
     Crt;
   Var
     a {limite inferior}, b {limite superior}: Real;
     p {paso de busqueda}, pr {presicion deseada}: Real;
     c {resultado parcial}, d {resultado parcial}: Real;
     e {resultado parcial}, f {resultado parcial}: Real;
     g {resultado parcial}: Real;
     a2,a1,a0:Real; {coeficientes de la funcion}
     preg:char; {busqueda de otra raiz}
 
   Function fx(x:real):real;
	begin
	fx:=a2*x*x+a1*x+a0
	end;
 
{Seccion algoritmica}
{Desarrollo de la solucion}
   Begin
   {Prologo}
       {Limpieza de pantalla}
          ClrScr;
       {Presentacion del programa}
        {Escribir titulo en pantalla}
          Writeln('Calculo de raices simples de f=a2x^2+a1x+a0');
          Writeln;
          Writeln('El programa realiza el calculo de raices simples');
          Writeln('de la funcion f=a2x^2+a1x+a0 por aproximacion sucesiva.');
       {Obtencion de datos}
          Writeln;
	  Writeln('Ingrese los coeficientes de la funcion separados por un');
	  Writeln('espacio y presione enter "a2 a1 a0"');
          Readln(a2,a1,a0);
	  Writeln;
          Writeln('Ingrese el limite inferior del intervalo');
          Write('deseado para buscar raices: ');
          Readln(a);
          Writeln;
          Writeln('Ingrese el limite superior del intervalo');
          Write('deseado para buscar raices: ');
          Readln(b);
          Writeln;
          Writeln('Ingrese el paso de busqueda requerido: ');
          Readln(p);
          Writeln;
          Writeln('Ingrese precision en el calculo de las raices: ');
          Readln(pr);
          Writeln;
      {Resolucion}
          a:= a-p;
          Repeat
            a:= a+p;
            c:= fx(a);
            d:= a;
            d:= d+p;
            e:= fx(d);
          Until (c*e<0) or (d>b);  {Obtencion del intervalo <=pr}
            If d>b    {Caso que no existen raices}
              Then
                Begin
                  Writeln;
                  Writeln('No hay raices de la funcion en el intervalo de busqueda');
                  Writeln;
                  Writeln('Presione Enter para volver a la pantalla de edicion');
                  Readln;
                End
              Else
                Begin
                   Repeat                     {Acotacion del intervalo en mitades}
                      c:= fx(a);
                      e:= fx(d);
                      f:= (a+d)/2;
                      g:= fx(f);
                        If g*c<0
                          Then
                            Begin
                              d:= f;
                            End
                          Else
                            Begin
                              a:= f;
                            End
                   Until (Abs(g)<=pr) or (Abs(c)<=pr) or (Abs(e)<=pr);
 
      {Epilogo}
         {Exhibicion del resultado en pantalla}
                 Write('La raiz es: ', F:2:6);
                 Write(#241, Pr:1:6);
                 Writeln;
                 Readln;
                 Write('¨Desea buscar otra raiz? s/n  ');
                 Readln(preg);
                 Writeln;
                 If preg='s' then
                    Begin
                    a:=f;
                    Repeat
                          a:= a+p;
                          c:= fx(a);
                          d:= a;
                          d:= d+p;
                          e:= fx(d);
                    Until (c*e<0) or (d>b);  {Obtencion del intervalo <=pr}
                          If d>b    {Caso que no existen raices}
                             Then
                             Begin
                             Writeln;
                             Writeln('No hay raices de la funcion en el intervalo de busqueda');
                             Writeln;
                             Writeln('Presione Enter para volver a la pantalla de edicion');
                             Readln;
                             End
                          Else
                             Begin
                             Repeat       {Acotacion del intervalo en mitades}
                             c:= fx(a);
                             e:= fx(d);
                             f:= (a+d)/2;
                             g:= fx(f);
                                 If g*c<0
                                    Then
                                    Begin
                                    d:= f;
                                    End
                                 Else
                                    Begin
                                    a:= f;
                                    End
                             Until (Abs(g)<=pr) or (Abs(c)<=pr) or (Abs(e)<=pr);
 
      {Epilogo}
         {Exhibicion del resultado en pantalla}
                 Write('La otra raiz es: ', F:2:6);
                 Writeln(#241, Pr:1:6);
                 Writeln;
                 Writeln('No hay mas raices');
                 Writeln;
                 Writeln('Gracias por utilizar el programa');
                 Readln;
 
                          End
                 End
                 Else
                     Writeln('Gracias por utilizar el programa');
                     Readln;
 
 
 
 
                 End;
 
End.