Suma de dos vectores en lenguaje ADA

La suma de dos vectores (V1, V2) de igual tamaño, es un nuevo vector, V3, del mismo tamaño que V1 y V2, tal que, cada elemento de V3 es la suma de los que ocupan las posiciones correspondientes (primera, segunda, tercera,...; independientemente de los índices que designen dichas posiciones) de V1 y V2.

Implemente una función de tipo Vector_1, llamada Suma_Vectores, con dos parámetros de tipo Vector_1. El resultado será la suma de los dos parámetros de la función. Dado que dos vectores sólo se pueden sumar cuando tienen el mismo número de elementos, la función lanzará una excepción Constraint_Error con el mensaje "Vectores incompatibles" cuando el tamaño de los parámetros de entrada sea distinto. El rango del índice del resultado deberá empezar siempre en 1, independientemente de cuáles fueran los rangos de índices de los parámetros de la función.

with Arrays; use Arrays;
function Suma_Vectores (V1, V2 : Vector_1) return Vector_1 is
suma : Vector_1 (1 .. V1'Length);
begin
if V1'Length = V2'Length then
for I in 1 .. V1'Length loop
suma (I) := V1 (V1'First + I - 1) + V2 (V2'First + I - 1);
end loop;
else
raise Constraint_Error with "Vectores incompatibles";
end if;
return suma;
end Suma_Vectores;

package Arrays is
type Vector_1 is array (Integer range <>) of Integer;
type Vector_2 is array (Positive range <>) of Integer;
type Matriz_1 is array (Integer range <>, Integer range <>) of Integer;
end Arrays;

Fila de mayor peso en una matriz en lenguaje ADA

Se define el peso de una fila de una matriz de enteros como la suma de todos sus elementos.

Implemente una función de tipo Integer, llamada Fila_Mayor_Peso, con un parámetro de tipo Matriz_1. La función devolverá el índice de la fila de mayor peso de la matriz pasada como parámetro. Si hay varias filas con el mismo peso se devolverá el índice menor.

with Arrays; use Arrays;
function Fila_Mayor_Peso (Matriz : Matriz_1) return Integer is
Fila_Maxima : Integer;
Indice_Fila_Maxima : Integer;
aux : Integer := Integer'First;
begin
for I in Matriz'Range (1) loop
Fila_Maxima :=1;
for J in Matriz'Range (2) loop
Fila_Maxima := Fila_Maxima + Matriz (I, J);
end loop;

if Fila_Maxima > aux then
Indice_Fila_Maxima := I;
aux := Fila_Maxima;
end if;
end loop;
return Indice_Fila_Maxima;
end Fila_Mayor_Peso;

package Arrays is
type Vector_1 is array (Integer range <>) of Integer;
type Vector_2 is array (Positive range <>) of Integer;
type Matriz_1 is array (Integer range <>, Integer range <>) of Integer;
end Arrays;

Apareciones de un elemento en un vector en lenguaje ADA

Implemente una función de tipo Natural, llamada Apariciones, con dos parámetros: el primero de tipo Vector_1 y el segundo de tipo Integer. La función debe devolver el número de veces que el valor representado por el segundo parámetro aparece en el array representado por el primero.


with Arrays; use Arrays;
function Apariciones (Vector : Vector_1; Valor : Integer) return Natural is
contador : Natural := 0;
begin
for i in Vector'Range loop
if Vector (i) = Valor then
contador := contador + 1;
end if;
end loop;
return contador;
end Apariciones;

package Arrays is
type Vector_1 is array (Integer range <>) of Integer;
type Vector_2 is array (Positive range <>) of Integer;
type Matriz_1 is array (Integer range <>, Integer range <>) of Integer;
end Arrays;

Número de positivos en un vector en lenguaje ADA

Implemente una función de tipo Natural, llamada Positivos, con un parámetro de tipo Vector_1, que devuelva el número de valores positivos contenidos en el array representado por dicho parámetro.

with Arrays; use Arrays;
function positivos (Vector : Vector_1) return Natural is
contador : Natural := 0;
begin
for I in Vector'Range loop
if Vector (I) > 0 then
contador := contador + 1;
end if;
end loop;
return contador;
end positivos;

package Arrays is
type Vector_1 is array (Integer range <>) of Integer;
type Vector_2 is array (Positive range <>) of Integer;
type Matriz_1 is array (Integer range <>, Integer range <>) of Integer;
end Arrays;

Practica en Lenguaje ADA: Implementa el préstamo Francés y Americano. También una cola FIFO, para las existencias en almacén.

with unchecked_deallocation,Text_Io,ada.integer_text_io,Ada.Float_Text_IO;
use Text_Io,ada.integer_text_io,Ada.Float_Text_IO;


procedure trabadministracion is
type nodo_lista;
type pnodo_lista is access nodo_lista;
type nodo_lista is record --lista doblemente encadenada
cantidad:integer;
precio:float;
siguiente:pnodo_lista;
anterior:pnodo_lista;
end record;
principio,final:pnodo_lista;--punteros al nodo ultimo y primero
---variables de los prestamos--
cantidad,cant,opcion:integer;
aux,precio:float;
---variables del lifo--
n,cont,s:integer;
g,anual,interes,i,c,f,a:float;

procedure Liberar_pnodo is new Unchecked_Deallocation(nodo_lista,Pnodo_lista);
--libera nodos del tipo pnodo_lista


procedure insertarfinal(cantidad: in integer;Precio: in float;principio,final: in out pnodo_lista) is
--inserta un nuevo nodo al final de la lista
recorrer:pnodo_lista;
begin
recorrer:=final;
if principio=null then --en caso de lista vacia
principio:=new nodo_lista;
principio.cantidad:=cantidad;
principio.precio:=precio;
final:=principio;
else --si la lista no esta vacia
final:=new nodo_lista;
final.cantidad:=cantidad;
final.precio:=precio;
recorrer.siguiente:=final;
final.anterior:=recorrer;
end if;
end insertarfinal;

procedure extraer(cant: in out integer;final: in out pnodo_lista)is
aux,aux2:pnodo_lista;
Cant_total:integer:=0 ;
begin
aux2:=final;
while aux2/=null loop
cant_total:=cant_total+aux2.cantidad;
aux2:=aux2.anterior;
end loop;
if cant>cant_total then
new_line;
put_line("La Cantidad Es Superior A La Actual");
else
if cant=final.cantidad then
aux:=final.anterior;
if principio/=final then
aux.siguiente:=null;
else
principio:=aux;
end if;
liberar_pnodo(final);
final:=aux;

else
if cant>final.cantidad then
cant:=cant-final.cantidad;
aux:=final.anterior;
liberar_pnodo(final);
aux.siguiente:=null;
final:=aux;
extraer(cant,final);
else
final.cantidad:=final.cantidad-cant;
end if;
end if;
end if;
end extraer;

procedure verpantalla(principio,final:pnodo_lista) is
--visualiza en pantalla la lista
recorrer:pnodo_lista;
begin
recorrer:=principio;
if not(recorrer=null) then --si la lista no esta vacia
--recorre toda la lista y pone el campo info en pantalla
while not(recorrer=null) loop
put("cantidad:");put(recorrer.cantidad);
put("precio:");put(recorrer.precio,fore=>5,aft=>2,exp=>0); --te pasa de la notacion cientifica a float
new_line;
recorrer:=recorrer.siguiente;
end loop;


else --si la lista esta vacia llama la excepcion
new_line;
put_line("No Hay Existencias");
end if;
end verpantalla;

function anualidad(c,i:float;n:integer)return float is
f,a,i2:float;
begin
i2:=i/100.0;
f:=1.0+i2;
f:=f**(-n);
f:=1.0-f;
f:=f/i2;
a:=c/f;
return (a);
end anualidad;

function cinteres(c,i,a:float;n,s:integer)return float is
f,i2,cinteres:float;
s2,n2:integer;
begin
s2:=s-1;
n2:=n-s2;
i2:=i/100.0;
f:=1.0+i2;
f:=f**(-n2);
f:=1.0-f;
f:=f/i2;
cinteres:=f*(anualidad(c,i,n))*i2;

return cinteres ;
end cinteres;

function camortizacion(c,i,a:float;n,s:integer)return float is
f,i2,i3,cinteres,a2,a3:float;
s2,n2:integer;
begin
i2:=i/100.0;
i3:=c*i2;
a2:=(anualidad(c,i,n))-i3;
s2:=s-1;
a3:=(1.0+i2)**s2;
a3:=a2*a3;

return a3 ;
end camortizacion;

function saldo(c,i,a:float;n,s:integer)return float is
f,i2,a2:float;
s2:integer;
begin
s2:=n-s;
i2:=i/100.0;
f:=1.0+i2;
f:=f**(-s2);
f:=1.0-f;
f:=f/i2;
a2:=(anualidad(c,i,n))*f;
return a2 ;
end saldo;
begin
loop
--begin
new_line;
put_line("*********************** Bienvenido A Este Programa *************************");
put_line("************** Administracion De Empresas II **************");
put_line("******* *******");
put_line("******* 1.= Terminar EL programa *******");
put_line("******* 2.= Realizado por *******");
put_line("******* 3.= Lifo *******");
put_line("******* 4.= Prestamos *******");
put_line("******* *******");
put_line("****************************************************************************");
new_line;
Put("Teclee su opcion");
get(opcion);
new_line;
case Opcion is
when 1=>
put_line("gracias por usar este programa");
exit;
when 2=>
new_line;
Put_line(" ***** Diseñadores Del Econominator ******");
new_line;
Put_line(" ** Jose Luis Cabrera Marrero ** ");
new_line;
Put_line(" ** Airam Caballero Perez **");
new_line;
Put_line(" ** Eduardo Hidalgo Luque **");
new_line;
Put_line(" ** Sergio Romero Sanchez **");
New_Line;
When 3=>
loop
new_line;
put_line("******************************* LIFO ********************************");
put_line("************** Administracion De Empresas II *************");
put_line("******* *******");
put_line("******* 1.= menu principal *******");
put_line("******* 2.= entradas *******");
put_line("******* 3.= salidas *******");
put_line("******* 4.= existencias actuales *******");
put_line("******* *******");
put_line("****************************************************************************");
new_line;
Put("Teclee su opcion");
get(opcion);
new_line;
case opcion is
when 1=>
EXIT;
when 2=>
put_line("-ENTRADAS-");
put("indique la cantidad de mercancia entrante:");
get(cantidad);
new_line;
put("precio al que entra la mercancia:");
get(precio);
insertarfinal(cantidad,precio,principio,final);
new_line;
put_line("¡¡ la entrada ha sido realizada ¡¡");
when 3=>
put_line("cantidad que va a salir del almacen");
get(cant);
extraer(cant,final);
new_line;

When 4=>
put_line("las existencia actuales son:");
verpantalla(principio,final);
When Others=>
Put_line("La Opcion Elegida Es Incorrecta");
New_Line;
New_Line;

End case;
end loop; ----fin del menu lifo
new_line;
when 4=>
loop
new_line;
put_line("******************************* PRESTAMOS ***************************");
put_line("************** Administracion De Empresas II *************");
put_line("******* *******");
put_line("******* 1.= menu principal *******");
put_line("******* 2.= Sistema Americano *******");
put_line("******* 3.= Sistema Frances *******");
put_line("******* *******");
put_line("****************************************************************************");
new_line;
Put("Teclee su opcion");
get(opcion);
new_line;
case opcion is
when 1=>
EXIT;
when 2=>
loop
new_line;
put_line("***************************** PRESTAMOS **************************");
put_line("**** --SISTEMA AMERICANO-- ****");
put_line("**** ****");
put_line("**** 1.= menu principal ****");
put_line("**** 2.= cuantia constante de interes a pagar en cada ano del prestamo ****");
put_line("**** 3.= cuantia constante que hay que imponer en el fondo ****");
put_line("**** ****");
put_line("*******************************************************************************");
new_line;
Put("Teclee su opcion");
get(opcion);
new_line;
case opcion is
when 1=>
exit;
when 2=>

put_line("introduzca el capital del prestamo");
get(c);
put_line("introduzca el interes del prestamo anual en %");
get(i);


begin
aux:=i/100.0;
interes:=c*aux;
new_line;
put_line("la cuantia de interes es :"); put(interes,fore=>5,aft=>3,exp=>0);

end;
when 3=>
put_line("introduzca el capital del prestamo");
get(c);
put_line("introduzca las imposiciones anules en %");
get(i);
put_line("introduzca la duracion del prestamo en años");
get(n);
begin
f:=i/100.0;
f:=(((1.0+f)**n)-1.0)/f;
cont:=0;
anual:=c/f;
new_line;
put_line("la cuantia es:"); put(anual,fore=>5,aft=>3,exp=>0);


end;
when others=>
put_line("La Opcion Es Incorrecta");
trabadministracion;
end case;
end loop; ---fin del menu sistema americano
when 3=>
put_line("introduzca el capital del prestamo");
get(c);
put_line("introduzca el interes del prestamo anual en %");
get(i);
put_line("introduzca la duracion del prestamo en años");
get(n);
loop

new_line;
put_line("**************************** PRESTAMOS ********************************");
put_line("************** ---SISTEMA FRANCES--- *************");
put_line("******* *******");
put_line("******* 1.= salir *******");
put_line("******* 2.= calcular la anualidad que amortiza el prestamo *******");
put_line("******* 3.= cuota de amortizacion de un periodo en concreto *******");
put_line("******* 4.= cuota de interes de un periodo concreto *******");
put_line("******* 5.= saldo del prestamo en un año concreto *******");
put_line("******* *******");
put_line("****************************************************************************");
new_line;
Put("Teclee su opcion");
get(opcion);
new_line;
case opcion is
when 1=>
exit;
when 2=>
put(anualidad(c,i,n),fore=>5,aft=>2,exp=>0);
when 3=>
put_line("introduzca el periodo que desea obtener:");
get(s);
if s>n then
put_line("el periodo seleccionado es mayor que los periodos de amortizacion del prestamo");
exit;
end if;
put_line("la cuota de amortizacion es:");
put(camortizacion(c,i,a,n,s),fore=>5,aft=>2,exp=>0);

when 4=>
put_line("introduzca el periodo que desea obtener:");
get(s);
if s>n then
put_line("el periodo seleccionado es mayor que los periodos de amortizacion del prestamo");
exit;
end if;
put_line("la cuota de interes es:");
put(cinteres(c,i,a,n,s),fore=>5,aft=>2,exp=>0);

when 5=>
put_line("introduzca el periodo que desea obtener:");
get(s);
if s>n then
put_line("el periodo seleccionado es mayor que los periodos de amortizacion del prestamo");
exit;
end if;
put_line("el saldo del prestamo es:");
put(saldo(c,i,a,n,s),fore=>5,aft=>2,exp=>0);
when others=>
put_line("La Opcion Es Incorrecta");
trabadministracion;


end case;
end loop; ----------fin del menu del prestamo fraces
when others=>
put_line("La Opcion Es Incorrecta");
trabadministracion;

end case;
end loop; ---fin del menu prestamos


when others=>
put_line("La Opcion Es Incorrecta");
trabadministracion;
end case;
--Creamos Las Excepciones Necesarias.").
Exception
When Data_error =>
new_line;
put_line("Los Parametros Introducidos Son Incorrectos");
skip_line;
new_line;
When others=>
Put_Line("Error Desconocido");
New_Line;
end;
end loop; ---fin menu principal
End trabadministracion;

Funciones sobre Matrices en lenguaje ADA, Transpuesta, Sobrecarga de los operadores *,+,-,=

* Desarrollar una serie de operaciones para manejo de matrices junto con un procedimiento principal de prueba. La interfaz de las operaciones en base a la cual hay que realizar la implementación es la que sigue:

1. Definir un tipo para declarar matrices de cualquier tamaño y rango de variación de los índices.

2. Sobrecarga del operador "=".
entrada: matrices a comparar.
pre: el número de valores de los rangos de los respectivos índices de las matrices a comparar debe coincidir.
post: devuelve verdadero si los correspondientes elementos de ambas matrices son iguales y, falso, si algún elemento de una de las matrices no coincide con el correspondiente de la otra.

3. Sobrecarga del operador "+".
entrada: matrices a sumar.
pre: el número de valores de los rangos de los respectivos índices de las matrices a sumar debe coincidir.
post: devuelve la matriz suma de los correspondientes elementos de las matrices dadas.

4. Sobrecarga del operador "-".
entrada: matrices a restar.
pre: el número de valores de los rangos de los respectivos índices de las matrices a restar debe coincidir.
post: Devuelve la matriz diferencia de los correspondientes elementos de las matrices dadas.

5. Sobrecarga del operador "*".
entrada: matrices a multiplicar.
pre: el número de valores del rango del 2º índice de la matriz primer operando debe coincidir con el número de valores del 1er. índice de la matriz segundo operando.
post: devuelve la matriz producto.

6. Función Transpuesta.
entrada: matriz a transponer. post: devuelve la transpuesta de una matriz con igual número de filas e igual número de columnas al de la correspondiente matriz de entrada.



with Text_IO;
use Text_IO;

procedure Sentencias is


-- *********** Definiciones de tipos y paquetes *************

type Opciones is range 0..10;
type Matriz_nr is array (integer range<>,integer range<>) of integer;
package Opciones_IO is new Integer_IO(Opciones);
Package Real_IO is new Float_IO(Float);
Package Entero_IO is new Integer_IO(Integer);
use Opciones_IO, Real_IO,Entero_IO;
---------------------------------------------------------------


-- ************** Procedimientos *************

-- Lee los elementos por pantalla y los almacena en la matriz
-- pasada por parametro.
procedure LeeMatriz(Mat :in out Matriz_nr) is
begin
for i in Mat'First(1)..Mat'Last(1) loop
for j in Mat'First(2)..Mat'Last(2) loop
put("Elemento[");put(i);put(",");put(j);put("] <- ");
get(Mat(i,j));
new_line;
end loop;
end loop;
end LeeMatriz;
---------------------------------------------------------------
---------------------------------------------------------------


-- Escribe la matriz pasada por parametro en la
-- pantalla.
procedure EscribeMatriz(Mat: in Matriz_nr) is
begin
for i in Mat'Range(1) loop
for j in Mat'First(2)..Mat'Last(2) loop
put(Mat(i,j)); put(" ");
end loop;
new_line;
end loop;
end EscribeMatriz;
---------------------------------------------------------------
---------------------------------------------------------------


-- Compara las dos matrices pasadas y devuelve si tienen
-- la misma dimension y son iguales.
function "="(M1,M2: in Matriz_nr) return boolean is
Result : boolean ;

begin
Result := true;
if ((M1'Length(1) = M2'Length(1)) and (M1'Length(2) = M2'Length(2))) then
-- dimensiones correctas? ..... seguimos ....
for i in 1..(M1'Length(1)) loop
for j in 1..(M1'Length(2)) loop
if ( M1(M1'First(1)+i-1,M1'First(2)+j-1)/=
M2(M2'First(1)+i-1,M2'First(2)+j-1) ) then
Result := false;
end if;
end loop;
end loop;
else
Result := false;
end if;
return Result;
end "=";
---------------------------------------------------------------
---------------------------------------------------------------


-- Suma la matriz segunda a la primera y devuelve la matriz
-- resultante.
function "+"(M1,M2: in Matriz_nr) return Matriz_nr is
Result : Matriz_nr(1..(M1'Length(1)),1..(M1'Length(2)));
begin
if ((M1'Length(1) = M2'Length(1)) and (M1'Length(2) = M2'Length(2))) then
-- dimensiones correctas? ..... seguimos ....
for i in 1..(M1'Length(1)) loop
for j in 1..(M1'Length(2)) loop
Result(i,j) := M1(M1'First(1)+i-1,M1'First(2)+j-1)+
M2(M2'First(1)+i-1,M2'First(2)+j-1);
end loop;
end loop;
else
put_line("Hagan caso omiso del contenido de M3!");
put_line("Hagan caso omiso del contenido de M3!");
put_line("Hagan caso omiso del contenido de M3!");
put_line("_____________________________________");
put_line("No coinciden las dimensiones");
put_line("_____________________________________");
new_line;
end if;
return Result;
end "+";
---------------------------------------------------------------
---------------------------------------------------------------


-- Resta la matriz segunda a la primera y devuelve la matriz
-- resultante.
function "-"(M1,M2: in Matriz_nr) return Matriz_nr is
Result : Matriz_nr(1..(M1'Length(1)),1..(M1'Length(2)));
begin
if ((M1'Length(1) = M2'Length(1)) and (M1'Length(2) = M2'Length(2))) then
-- dimensiones correctas? ..... seguimos ....
for i in 1..(M1'Length(1)) loop
for j in 1..(M1'Length(2)) loop
Result(i,j) := M1(M1'First(1)+i-1,M1'First(2)+j-1)-
M2(M2'First(1)+i-1,M2'First(2)+j-1);
end loop;
end loop;
else
put_line("No coinciden las dimensiones");
put_line("_____________________________________");
put_line("Hagan caso omiso del contenido de M3!");
put_line("_____________________________________");
new_line;
end if;
return Result;
end "-";
---------------------------------------------------------------
---------------------------------------------------------------


-- Multiplica la primera matriz por la segunda y
-- devuelve la matriz resultante.
function "*"(M1,M2: in Matriz_nr) return Matriz_nr is
Result : Matriz_nr(1..(M1'Length(1)),1..(M2'Length(2)));
begin
if (M1'Length(2) = M2'Length(1)) then
-- dimensiones correctas? ..... seguimos ....
for i in 1..(M1'Length(1)) loop
for j in 1..(M2'Length(2)) loop
Result(i,j) := 0 ;
for k in 1..(M1'Length(2)) loop
Result(i,j) := Result(i,j) +
M1(M1'First(1)+i-1,M1'First(2)+k-1)*
M2(M2'First(1)+k-1,M2'First(2)+j-1);
end loop;
end loop;
end loop;
else
put_line("No coinciden las dimensiones");
put_line("_____________________________________");
put_line("Hagan caso omiso del contenido de M3!");
put_line("_____________________________________");
new_line;
end if;
return Result;
end "*";
---------------------------------------------------------------
---------------------------------------------------------------


-- Transpone una matriz
function Transpuesta(M1: in Matriz_nr) return Matriz_nr is
Result : Matriz_nr(1..(M1'Length(2)),1..(M1'Length(1)));
begin
for i in 1..(M1'Length(1)) loop
for j in 1..(M1'Length(2)) loop
if (i=j) then
Result(i,j) := M1(M1'First(1)+i-1 ,M1'First(2)+j-1);
else
Result(j,i) := M1( M1'First(1)+i-1 , M1'First(2)+j-1 );
end if;
end loop;
new_line;
end loop;
return Result;
end Transpuesta;
---------------------------------------------------------------
---------------------------------------------------------------


-- ************* Programa Principal **************************

--Declaraciones de variables
o : Opciones ;
OpciónLeída : Opciones ;
M1ii,M1if,M2ii,M2if : integer ;
M1ji,M1jf,M2ji,M2jf : integer ;
begin
put_line("Bienvenido");
put_Line("Practica 1 _________________________________");
put_Line("Programa de tratamiento de matrices: ");
put_Line("");
put_Line("Primero leeremos los rangos de las 2 matrices");
put_Line("");
put_Line("Matriz 1");
put_Line("________");
put_Line("");
put_Line("Filas");
put_Line("-----");
put("Valor inicial : ");get(M1ii);
put("Valor final : ");get(M1if);
put_Line("");
put_Line("Columnas");
put_Line("--------");
put("Valor inicial : ");get(M1ji);
put("Valor final : ");get(M1jf);
put_Line("");
put_Line("Matriz 2");
put_Line("________");
put_Line("");
put_Line("Filas");
put_Line("-----");
put("Valor inicial : ");get(M2ii);
put("Valor final : ");get(M2if);
put_Line("");
put_Line("Columnas");
put_Line("--------");
put("Valor inicial : ");get(M2ji);
put("Valor final : ");get(M2jf);
put_Line("");


--El programa permanece en un bucle hasta que se elige terminar
declare
M1 : Matriz_nr(M1ii..M1if,M1ji..M1jf);
M2 : Matriz_nr(M2ii..M2if,M2ji..M2jf);
M3S : Matriz_nr(1..(M1'Length(1)),1..(M1'Length(2)));
M3P : Matriz_nr(1..(M1'Length(1)),1..(M2'Length(2)));
M3T : Matriz_nr(1..(M1'Length(2)),1..(M1'Length(1)));
M3T2 : Matriz_nr(1..(M2'Length(2)),1..(M2'Length(1)));
begin
loop
--Presentación del menú de opciones

put_Line("__________________MENU______________________");
put_Line(" 0 - Terminar ");
put_Line(" 1 - Rellenar matriz 1 ");
put_Line(" 2 - Rellenar matriz 2 ");
put_Line(" 3 - Comparacion (sobrecarga de =) ");
put_Line(" 4 - Suma (sobrecarga de +) ");
put_Line(" 5 - Resta (sobrecarga de -) ");
put_Line(" 6 - Producto (sobrecarga de *) ");
put_Line(" 7 - Transpuesta ");
put_Line("____________________________________________");
put("Elija su opcion: ");get(OpciónLeída);
new_line;
new_line;
case OpciónLeída is --Se ejecuta la opción elegida

when 0 => exit;

when 1 => begin
put_line("Leyendo M1..........");
new_line;
LeeMatriz(M1);
put_line("Contenido de M1.....");
new_line;
EscribeMatriz(M1);
end;

when 2 => begin
put_line("Leyendo M2..........");
new_line;
LeeMatriz(M2);
put_line("Contenido de M2.....");
new_line;
EscribeMatriz(M2);
end;

when 3 => begin
put_line("Comparando M1 con M2.....");
new_line;
if (M1=M2) then
put_line("Las matrices M1 y M2 son 'Iguales' ");
else
put_line("Las matrices M1 y M2 son 'Distintas'");
end if;
new_line;
end;


when 4 => begin
put_line("Sumando M1 y M2.....");
new_line;
M3S := M1 + M2;
put_line("Resultado en M3.");
new_line;
put_line("Leyendo M3.....");
new_line;
EscribeMatriz(M3S);
end;

when 5 => begin
put_line("Restando M1 y M2..........");
new_line;
M3S := M1 - M2;
put_line("Resultado en M3.");
new_line;
put_line("Leyendo M3.....");
new_line;
EscribeMatriz(M3S);
end;

when 6 => begin
put_line("Multiplicando M1 y M2.....");
new_line;
M3P := M1 * M2;
put_line("Resultado en M3.");
new_line;
put_line("Leyendo M3.....");
new_line;
EscribeMatriz(M3P);
end;

when 7 => begin
loop
put_line ("Seleccione la matriz a transponer:");
put_line ("1.- tranpone la matriz M1");
put_line ("2.- tranpone la matriz M2");
put ("seleccione : ");get(o);
new_line;
exit when ((o=1) or (o=2));
end loop;
if (o=1) then
put_line("Transponiendo M1.....");
new_line;
M3T := Transpuesta(M1);
put_line("Resultado en M3.");
new_line;
put_line("Leyendo M3.....");
new_line;
EscribeMatriz(M3T);
else
put_line("Transponiendo M2.....");
new_line;
M3T2 := Transpuesta(M2);
put_line("Resultado en M3.");
new_line;
put_line("Leyendo M3.....");
new_line;
EscribeMatriz(M3T2);
end if;
end;

when others => put_line("La opcion elegida no es valida");
end case;
new_line;
new_line;
end loop;
put_line("Gracias, por usar este programa");
end;
return;
end Sentencias;

Programa que simula una cola de Impresión en lenguaje ADA

* Descargar el fichero prac06.ada y completar el código que falta en base a los siguientes requisitos. Desarrollar un programa que simule una Cola de Impresión, —recepción en la Cola y envío de trabajos a la impresora—. La Cola de Impresión deberá implementarse en una Cola Circular si es en memoria estática, o en memoria dinámica, en cualquier caso de tamaño 20. Tendrá asímismo dos indicadores que nos permitirán localizar el primer trabajo que se va a imprimir y cuál es el último de la Cola. En la Cola de Impresión se almacenará exclusivamente el número de páginas de cada trabajo.
* Para el desarrollo de tal simulación se implementarán dos tareas concurrentes: LlenaCola y VacíaCola, la primera se entrega implementada en el fichero prac06.ada y simula el envío aleatorio de trabajos a la Cola de Impresión , indicando el número de páginas también de forma aleatoria; la segunda deberá simular un proceso concurrente que está continuamente escaneando la Cola de Impresión y en caso de existir algún trabajo pendiente de imprimir se eliminará de dicha Cola —se supone el envío a la impresora—. No se podrá enviar a la impresora —eliminación del primero de la Cola— otro trabajo hasta que el anterior termine. La impresora tiene una velocidad de impresión de 50 páginas por segundos.
* Se ilustra un ejemplo del estado de la Cola de Impresión, donde el siguiente trabajo a imprimir posee 67 páginas y por lo tanto después de ser eliminado no podrá eliminarse el siguiente hasta, al menos, pasados 0.02 * 67 segundos.



WITH Ada.Text_IO,Ada.Integer_Text_IO,Ada.Numerics.Discrete_Random,Unchecked_Deallocation;
USE Ada.Text_IO,Ada,Ada.Integer_Text_IO;

PROCEDURE Principal IS
subtype Páginas is Integer range 1..100;
package RandomPáginas is new Ada.Numerics.Discrete_Random (Páginas);
use RandomPáginas;
subtype Duración is Integer range 1..100;
package RandomDuración is new Ada.Numerics.Discrete_Random (Duración);
use RandomDuración;
------------------------------------
type Nodo;
type PCola is access Nodo;
type Nodo is record
Info: Integer;
Sig: PCola:=null;
end record;

type Cola is record
Pri: PCola:=null;
Ult: PCola:=null;
end record;
---------------------------------------


-- Implemente la especificación de las Tareas.
task type LlenaCola;
task type VacíaCola;

-- Implemente la especificación de MonitorCola.
protected type MonitorCola is
entry AñadirTrabajo(NumeroPaginas: in Páginas);
entry ImprimirTrabajo(NumPaginas: out integer);
procedure mostrar;
private
C: Cola;
EnCola: Integer:=0;
end MonitorCola;


procedure Libera is new Unchecked_Deallocation(Nodo,PCola);

ColaImpresión : MonitorCola; -- Variable de tipo protegido (protected).


-- Implemente el cuerpo de MonitorCola.
--------------------------------------------------------------------------
protected body MonitorCola is
----------------------------------------------
entry AñadirTrabajo(NumeroPaginas: in Páginas) when EnCola < 20 is
begin
if EnCola=0 then
C.Pri:=new Nodo;
C.Pri.Info:=NumeroPaginas;
C.Ult:=C.Pri;
else
C.Ult.Sig:=new Nodo;
C.Ult:=C.Ult.Sig;
C.Ult.Info:=NumeroPaginas;
end if;
EnCola:=EnCola+1;
Mostrar;
end AñadirTrabajo;
----------------------------------------------
entry ImprimirTrabajo(NumPaginas: out integer) when EnCola>0 is
Aux: PCola:=C.Pri;


begin
C.Pri:=C.Pri.Sig;
NumPaginas:=Aux.Info;
Libera(Aux);
EnCola:=EnCola-1;
Mostrar;
end ImprimirTrabajo;
----------------------------------------------
----------------------------------------------
procedure mostrar is
Aux: PCola:=C.Pri;
begin
Put("Cola[");
Put(EnCola,2);
Put("]->");
while Aux/=null loop
Put(Aux.Info,3);
Aux:=Aux.Sig;
if Aux/=null then
Put(",");
end if;
end loop;
New_Line;
end Mostrar;
----------------------------------------------
end MonitorCola;

--------------------------------------------------------------------------
-- Implemente el cuerpo de la Tarea VacíaCola.
task body VacíaCola is
N: Integer;
begin
loop
ColaImpresión.ImprimirTrabajo(N);
delay 0.02*N;
end loop;
end VacíaCola;


-- Implementación del cuerpo de LLenaCola. Esta tarea envía trabajos a la cola de impresión
-- con una frecuencia de 0.7 trabajos por segundo como media. Asímismo dichos trabajos poseen
-- 50 páginas como media. Si se desea puede modificar el número 35 para comprobar como se llena o
-- se mantiene vacía la cola, dado que se modifica la frecuencia de envío de los trabajos.


TASK BODY LlenaCola IS
G1: RandomDuración.generator;
G2: RandomPáginas.generator;
BEGIN
reset(G1);
reset(G2);
LOOP
ColaImpresión.AñadirTrabajo(random(G2));
delay Duration(1);
END LOOP;
END LlenaCola;


-- Variables de tipo tarea (task).
A:LlenaCola;
B:VacíaCola;
BEGIN
null;
END Principal;

Eliminar El Primer Nodo de la Lista en lenguaje ADA

Implemente un procedimiento llamado Eliminar, con dos parámetros, el primero de de tipo P_Nodo_Simple que representa las dirección de comienzo de una lista simplemente encadena y el segundo de tipo Integer. La función debe eliminar el primer nodo de la lista cuyo campo Info coincida con el valor del segundo parámetro.

-- Fichero listas

with Unchecked_Deallocation;

package Listas is
-- Tipos para construir una lista simplemente encadenada

type Nodo_Simple;
type P_Nodo_Simple is access Nodo_Simple;
type Nodo_Simple is record
Info : Integer;
Siguiente : P_Nodo_Simple;
end record;

-- Procedimiento para liberar un Nodo_Simple

procedure Liberar is new Unchecked_Deallocation (
Nodo_Simple,
P_Nodo_Simple);

end Listas;

with Listas; use Listas;

procedure Eliminar (Lista : in out P_Nodo_Simple; V : Integer) is
Iterador : P_Nodo_Simple := Lista;
Eliminado : P_Nodo_Simple := null;
begin
-- Mientras haya lista
if Iterador /= null then
-- en caso de que el valor sea el del primer nodo
if Iterador.Info = V then
-- avanzamos lista
Lista := Lista.Siguiente;
-- y liberamos iterador
Liberar (Iterador);
else
-- mientras no llegemos al final y no sea el valor
while Iterador.Siguiente /= null and then Iterador.Siguiente.Info /= V
loop
-- avanzamos iterador
Iterador := Iterador.Siguiente;
end loop;
-- preguntamos por la condicion critica, si es esta, es que se ha
-- encontrado el valor
if Iterador.Siguiente /= null then
-- Guardamos la direccion que queremos eliminar
Eliminado := Iterador.Siguiente;
-- avanzamos iterador al siguiente nodo
Iterador.Siguiente := Eliminado.Siguiente;
-- y liberamos
Liberar (Eliminado);
end if;
end if;
end if;
end Eliminar;

Calculo Letra DNI en lenguaje ADA

function NIF (DNI : String) return String is
Letras : constant String := "TRWAGMYFPDXBNJZSQVHLCKE";

Resultado : String (1 .. 10);
Valor_DNI : Integer := Integer'Value (DNI);
Letra_NIF : Character;
Pos_Letra : Integer;
begin
Pos_Letra := (Valor_DNI mod 23) + 1;
Letra_NIF := Letras (Pos_Letra);
Resultado := DNI & '-' & Letra_NIF;
return Resultado;
end NIF;

Maximo Comun Divisor en lenguaje ADA

function MCD (A, B : Positive) return Positive is
Mayor, Menor, Resta : Integer;
begin
-- Calculos inciales del primer Mayor, Menor y Resta
Mayor := A;
Menor := B;
Ordenar (Mayor, Menor);
Resta := Mayor - Menor;
-- Se continúa hasta que la resa da cero
while Resta > 0 loop
Mayor := Resta;
Ordenar (Mayor, Menor);
Resta := Mayor - Menor;
end loop;
return Mayor;
end MCD;

La funcion ordenar seria la siguiente:

procedure Ordenar (X, Y : in out Integer) is
Aux : Integer;
begin
-- Se mira si hay que intercambiar los parámetros
if X < Y then
Aux := X;
X := Y;
Y := Aux;
end if;
end Ordenar;

Calcular el Factorial en lenguaje ADA

Calculo del Factorial Iterativo:

procedure Calcular_Factorial (Num : in Natural; Fact : out Natural) is
-- Aquí las variables locales
begin
-- Calcular factorial
Fact := 1;
for I in 1 .. Num loop
Fact := Fact * I;
end loop;
end Calcular_Factorial;

Eliminar de un Lista el primer valor repetido del pasado por parámetro en lenguaje ADA

Implemente un procedimiento llamado Eliminar, con dos parámetros, el primero de de tipo P_Nodo_Simple que representa las dirección de comienzo de una lista simplemente encadena y el segundo de tipo Integer. La función debe eliminar el primer nodo de la lista cuyo campo Info coincida con el valor del segundo parámetro.

La declaración de la lista sería la siguiente:

package Listas is
-- Tipos para construir una lista simplemente encadenada
type Nodo_Simple;
type P_Nodo_Simple is access Nodo_Simple;
type Nodo_Simple is record
Info : Integer;
Siguiente : P_Nodo_Simple;
end record;
end Listas;


procedure Eliminar (Lista : in out P_Nodo_Simple; V : Integer) is
Iterador : P_Nodo_Simple := Lista;
Eliminado : P_Nodo_Simple := null;
begin
-- Mientras haya lista
if Iterador /= null then
-- en caso de que el valor sea el del primer nodo
if Iterador.Info = V then
-- avanzamos lista
Lista := Lista.Siguiente;
-- y liberamos iterador
Liberar (Iterador);
else
-- mientras no llegemos al final y no sea el valor
while Iterador.Siguiente /= null and then Iterador.Siguiente.Info /= V
loop
-- avanzamos iterador
Iterador := Iterador.Siguiente;
end loop;
-- preguntamos por la condicion critica, si es esta, es que se ha
-- encontrado el valor
if Iterador.Siguiente /= null then
-- Guardamos la direccion que queremos eliminar
Eliminado := Iterador.Siguiente;
-- avanzamos iterador al siguiente nodo
Iterador.Siguiente := Eliminado.Siguiente;
-- y liberamos
Liberar (Eliminado);
end if;
end if;
end if;
end Eliminar;

Ordenar Tres Valores en lenguaje ADA

Implemente un procedimiento llamado Ordenar con tres parámetros de entrada/salida de tipo Integer. Este procedimiento deberá ordenar sus parámetros de forma que en el primero quede el valor menor, en el segundo el valor intermedio y en el tercero el valor mayor de los tres (puede haber valores repetidos).

procedure ordenar (A, B, C : in out Integer) is
-- declaramos una variable auxiliar para hacer el intercambio de variables
aux : Integer;
begin
-- si a > b, intercambiamos a con b
if A > B then
aux := A;
A := B;
B := aux;
end if;
-- si c < a, intercambiamos c con a
if C < A then
aux := C;
C := A;
A := aux;
end if;
-- si c < b, intercambiamos c con b
if C < B then
aux := C;
C := B;
B := aux;
end if;
-- fin procedimiento
end ordenar;

Función Mes del Año en lenguaje ADA

Implemente una función de tipo Natural llamada Mes con un parámetro de entrada de tipo Positive. Esta función devolverá el número de días del mes cuyo ordinal es representado por el valor del parámetro. Si el valor del parámetro no está comprendido entre 1 y 12 (meses válidos), la función devolverá el valor 0.

function Mes (m : in Positive) return Natural is
begin
-- nos aseguramos que sea un mes valido
if (m > 0) and (m < 13) then
-- Febrero tiene 28 dias
if m = 2 then
return 28;
end if;
-- Hacemos una separacion entre los meses de Julio(7) y Agosto(8)
-- porque ambos meses tienes 31 dias, y si ponemos solo la primera
-- condicion del bucle Agosto saldra con 30 dias porque 8 mod 2 = 0
if (m <= 7 and m mod 2 = 1) or
(m >= 8 and m mod 2 = 0)
-- Con la segunda condicion si se cumple que
-- agosto tenga 31 dias, porque 8 mod 2 = 0, y entra en el bucle.
then
return 31;
else
return 30;
end if;
else
-- en cualquier otro caso devuelve 0
return 0;
end if;
end Mes;

Procedimiento Dia de la Semana en lenguaje ADA (day_1)

Implemente un procedimiento llamado Day_1 con un parámetro de entrada de tipo Natural que muestre al usuario el mensaje: "LUNES", "MARTES", "MIÉRCOLES", "JUEVES", "VIERNES", "SÁBADO" o "DOMINGO", según el valor del parámetro sea: 1, 2, 3, 4, 5, 6, o 7. Si el valor del parámetro no está comprendido entre 1 y 7, el procedimiento mostrará el mensaje: "DESCONOCIDO".

with Text_IO; use Text_IO;
-- Procedimiento Day_1
procedure Day_1 (X : in Natural) is
begin
-- utilizamos un case para elegir las diferentes opciones
-- dependiendo del valor que se introduzca
case X is
when 1 =>
Put ("LUNES");
when 2 =>
Put ("MARTES");
when 3 =>
Put ("MIÉRCOLES");
when 4 =>
Put ("JUEVES");
when 5 =>
Put ("VIERNES");
when 6 =>
Put ("SÁBADO");
when 7 =>
Put ("DOMINGO");
when others =>
Put ("DESCONOCIDO");
end case;
-- Fin Procedimiento
end Day_1;

Dia de la Semana en lenguaje ADA (day)

Implemente un programa llamado Day que muestre al usuario un mensaje solicitándole un número entero comprendido entre 1 y 7, y muestre el mensaje: "LUNES", "MARTES", "MIÉRCOLES", "JUEVES", "VIERNES", "SÁBADO" o "DOMINGO", según el número introducido por el usuario sea: 1, 2, 3, 4, 5, 6, o 7. Si el usuario introduce un número que no está comprendido entre 1 y 7, el programa mostrará el mensaje: "DESCONOCIDO".

with Text_IO, Ada.Integer_Text_IO; use Text_IO, Ada.Integer_Text_IO;
procedure Day is
a : Integer;
begin
Put_Line ("Introduzca Un Numero Entero Entre 1 y 7:");
New_Line;
Get (a);
-- utilizamos un case para elegir las diferentes opciones
-- dependiendo del valor que se introduzca
case a is
-- caso 1 devuelve lunes
when 1 =>
Put ("LUNES");
-- caso 2 devuelve martes
when 2 =>
Put ("MARTES");
-- caso 3 devuelve miercoles
when 3 =>
Put ("MIÉRCOLES");
--caso 4 devuelve jueves
when 4 =>
Put ("JUEVES");
--caso 5 devuelve viernes
when 5 =>
Put ("VIERNES");
--caso 6 devuelve Sabado
when 6 =>
Put ("SÁBADO");
--caso 1 devuelve domingo
when 7 =>
Put ("DOMINGO");
--en otro caso devuelve desconocido
when others =>
Put ("DESCONOCIDO");
end case;
end Day;

Signo de un Numero en lenguaje ADA

Implemente un programa llamado Signo que muestre al usuario un mensaje solicitándole un número entero y, en función de la respuesta tecleada por el usuario, muestre el mensaje: "NEGATIVO", "CERO" o "POSITIVO", según corresponda.

with Text_IO, Ada.Integer_Text_IO; use Text_IO, Ada.Integer_Text_IO;
-- Procedimiento que introduciendole un numero entero
-- nos dice si éste es positivo, negativo o es cero
procedure signo is
a : Integer;
begin
Put_Line ("Introduzca Un Numero Entero:");
New_Line;
Get (a);
-- si a es menor que 0 el numero es negativo
if a < 0 then
Put_Line ("NEGATIVO");
else
-- si a es mayor que 0 el numero es negativo
if a > 0 then
Put_Line ("POSITIVO");
else
-- sino el valor es cero
Put_Line ("CERO");
end if;
end if;
end signo;

Hola Mundo en lenguaje ADA

Implemente un programa llamado Hola que muestre al usuario el mensaje: "HOLA MUNDO".

with Text_IO; use Text_IO;
procedure Hola is
begin
-- imprimimos hola mundo
Put ("HOLA MUNDO");
end Hola;