Línea a Línea

Obtener los números de los proyectos a los cuales suministra partes por lo menos un proveedor situado en una ciudad distinta.

2008-03-01T19:06:00.001Z

Select Distinct J.J #
From SPJ , S, J
Where SPJ.S# = S.S#
And SPJ.J# = J.J#
And S.ciudad<> J.ciudad;

Algebra: ((( J rename ciudad as jciudad) join SPJ join (s rename ciudad as sciudad)) where jciudad<>sciaudad) [j#]

Obtener los números de partes suministradas a un proyecto por un proveedor situado en la misma ciudad que el proyecto

2008-03-01T19:05:00.002Z

Select Distinct P #
From SPJ , S, J
Where SPJ.S# = S.S#
And SPJ.J# = J.J#
And S.ciudad= J.ciudad;
Algebra: (J Join SPJ Join S) [P#]

Obtener los números de las partes suministradas a todos los proyectos de Londres.

2008-03-01T19:05:00.001Z

Selec P#
From SPJ SPJX
Where not exists (select *
From J
Where ciudad=’Londres’
And not exists (select *
From SPJ SPJY
Where SPJY.P# = SPJX.P#
And SPJY.J = J.J#));

Obtener los números de los proyectos a los cuales no suministra ninguna parte roja ninguno de los proveedores de Londres.

2008-03-01T19:04:00.002Z

Select J#
From J
Where not exists (select *
From SPJ
Where J# = J.J#
And P# in (select P#
From P
Where color =’rojo’)
And S# in (select S#
From S
Where ciudad =’Londres’));

Obtener los códigos de los proyectos a los cuales suministren partes todos y cada uno de los proveedores que suministren alguna parte roja.

2008-03-01T19:04:00.001Z

Select Distinct J#
from SPJ, SPJX
where not exists (select *
from SPJ SPJY
where exists (select *
from SPJ SPJA
where SPJA.S# = SPJY.S#
and SPJA.P# in (select P#
from P
where color = ‘Rojo’)
and not exists (select *
from SPJ SPJB
where SPJB.S# = SPJY.S#
and SPJB.J# = SPJX.J#)));

Obtener los números de los proveedores que suministren por lo menos una de las partes suministradas por al menos uno de los proveedores que suministra

2008-03-01T19:03:00.000Z

Siempre Trabajando sobre esta Base de Datos:
S(S#, Snombre, Situación, Ciudad)
P(P#, Pnombre, Color, Peso, Ciudad)
J(J#, Jnombre, ciudad)
SPJ(S#,P#,J#, Cantidad)

Select Distinct S#
From SPJ
Where P# in (select P#
From SPJ
Where S# in (Select S#
From SPJ
Where P# in (Select P#
From P
Where COLOR = ‘Rojo’)));

Algebra: ((( SPJ Join (P where Color = “Rojo” ) [P#]) [S#] join SPJ) [P#] join SPJ) [S#]

Consigue los nombres de los suministradores que no venden a la parte p2.

2008-03-01T19:02:00.002Z

Select Snombre
From S
Where not exists (Select *
From SPJ
Where S# = S.S#)
And P# = “P2”);

Obtener los códigos de los proveedores que venden al menos todas las partes vendidas por el proveedor S2.

2008-03-01T19:02:00.001Z

Select distintc S#
From SPJ SPJX
Where not exists (Select *
From SPJ SPJY
Where S# = ‘S2’
And not exists (Select *
From SPJ
Where S# = SPJX.S#
And P# = SPJY.P#));

Algebra: SPJ [S#, P#, J#] divideby (SPJ where S# = ‘S2’) [P#]

Dame todos los nombres de los suministradores que venden todas las partes.

2008-03-01T19:01:00.002Z

Select Snombre
From S
Where not exists (Select *
From P
Where not exists (Select *
From SPJ
Where S# = S.S#
And P# = P.P#));

Algebra: (SPJ[S#,P#] divided by P[P#] joins S)[Snombre]

Obtener los códigos de parte y el número de ventas de aquellas partes que presentes el mayor número de ventas.

2008-03-01T19:01:00.001Z

Select P#, count (*)
Fro SPJ
Group By P#
Having count (*) >= all (Select count(*)
From SPJ
Group By P#);

Obtener el código y la cantidad total suministrada de aquellas partes que han sido vendidas a todos los proyectos

2008-03-01T19:00:00.002Z

Select P#, sum(cantidad)
From SPJ A
Where not exists ( Select *
From J
Where not exists (Select *
From SPJ
Where P# = A.P#
And J# = J.J#));
Group by P#;

¿Cuántas partes han sido vendidas a todos los proveedores residentes en la ciudad en que se fabrica la parte?

2008-03-01T19:00:00.001Z

Select count (*)
From P
Where not exists (Select *
From S
Where Ciudad =P.Ciudad
And not exists (Select *
From SPJ
Where P#=P.P#
And S#=S.S#));

Obtener los códigos de los proveedores que no venden partes de Londres a ningún proyecto de Londres

2008-03-01T18:59:00.000Z

Select S#
From S
Where not exists (Select *
From SPJ
Where S# = S.S#
And P# in (select P#
From P
Where ciudad=”Londres”)
And J in (select J#
From J
Where ciudad = “Londres”));

Indique los códigos de los proveedores que venden a un único proyecto.

2008-03-01T18:58:00.002Z

Select distinct S#
From SPJ X
Where S# not in (select S#
From S
Where X.J#<>J#);

Algebra: SPJ[S#] minus
((SPJ[S#, J#] Join ((SPJ rename J# as Jnum)(S#, Jnum)) where J#<> Jnum) [S#])

Indique los códigos de las partes que vende el proveedor “S1”, pero no las vende en exclusiva.

2008-03-01T18:58:00.001Z

Select J#
From J
Where J# in (select J#
From SPJ
Where S# = ‘S1’);

Obtener los códigos de los proyectos de los proveedores que venden todas las partes usadas en el proyecto “J1” y solo las partes usadas por el proyect

2008-03-01T18:57:00.002Z

Siempre Trabajando sobre esta Base de Datos:
S(S#, Snombre, Situación, Ciudad)
P(P#, Pnombre, Color, Peso, Ciudad)
J(J#, Jnombre, ciudad)
SPJ(S#,P#,J#, Cantidad)

select S#
From S
Where not exists (Select P#
From P
Where exists (select *
From SPJ
Where P# = P.P# and J# = “J1”)
And not exists (select *
From SPJ
Where P# = P.P# and S# = S# = S.S#))
And not exists (Select P#
From P
Where exists (select *
From SPJ
Where P# = P.P# and S# = S.S#)
And not exists (select *
From SPJ
Where P# = P.P# and J# = “J1”));

Algebra: (SPJ where J#<> ‘j1’) [P#] P[P#] minus (SPJ where J# =’j1’) [P#]

Obtener las ciudades donde hay proyectos que usan todas las partes vendidas en exclusiva por el proveedor “S1”

2008-03-01T18:57:00.001Z

Siempre Trabajando sobre esta Base de Datos:
S(S#, Snombre, Situación, Ciudad)
P(P#, Pnombre, Color, Peso, Ciudad)
J(J#, Jnombre, ciudad)
SPJ(S#,P#,J#, Cantidad)

Select distinct Ciudad
From J
Where not exists (select P#
From SPJ A
Where not exixts (select *
From SPJ
Where P# = A.P#
And S#<>”S1”)
And not exists (select *
From SPJ
Where P# = A.P#
And J# = J.J#));

Indique los códigos de las partes que se usan solamente en el proyecto “J1”.

2008-03-01T18:56:00.001Z

Siempre Trabajando sobre esta Base de Datos:
S(S#, Snombre, Situación, Ciudad)
P(P#, Pnombre, Color, Peso, Ciudad)
J(J#, Jnombre, ciudad)
SPJ(S#,P#,J#, Cantidad)

Select distinct P#
From SPJ
Where not exists (Select *
From SPJ
Where P# = A.P#
And J#<>”J1”);

Indique las ciudades donde residen suministradores que venden todas las partes.

2008-03-01T18:54:00.005Z

Select Distinct Ciudad
From S
Where not exists (select *
From P
Where not exists (select *
From SPJ
Where P.P# = P#
And S.S# = S#));

((SPJ[S#,P#] divide by P[#]) join S) [ciudad]

Obtener los códigos de los proyectos para los cuales ‘S1’ es el único suministrador.

2008-03-01T18:54:00.003Z

Select Distinct J#
from SPJ, SPJX
where not exists (select *
from SPJ SPJY
where SPJY.J## = SPJX.J#
and SPJY.S#<>”S1”);

Algebra: (SPJ where S# = ‘S1’) [J#] minus (SPJ where S# <>‘S1’) [J#]

Indique los códigos de las partes vendidas en exclusiva por el proveedor “S3”

2008-03-01T18:54:00.001Z

Obtener los códigos de los proyectos tales que al menos cierta cantidad de cada parte utilizada por ellos le sea suministrada por el proveedor S1.

2008-03-01T18:53:00.001Z

Select Distinct J#
from SPJ, SPJX
where not exists (select *
from SPJ SPJY
where exists(select *
from SPJ SPJA
where SPJA.P# = SPJY.P#
and SPJ.J# = SPJX.J#)
and not exists (select *
from SPJ SPJB
where SPJB.S# = ‘S1’
and SPJB.P#.= SPJY.P#
and SPJB.J# = SPJX.J#));

Obtener los códigos de los proyectos a los cuales el proveedor S1 suministres todos los tipos de parte suministrados por él.

2008-03-01T18:52:00.002Z

Siempre Trabajando sobre esta Base de Datos:
S(S#, Snombre, Situación, Ciudad)
P(P#, Pnombre, Color, Peso, Ciudad)
J(J#, Jnombre, ciudad)
SPJ(S#,P#,J#, Cantidad)

Select Distinct J#
from SPJ, SPJX
where not exists (select P#
from SPJ SPJY
where exists(select *
from SPJ SPJA
where SPJA.S# = ‘S1’
and SPJ.P# = SPJY.P#)
and not exists (select *
from SPJ SPJB
where SPJB.S# = ‘S1’
and SPJB.P#.= SPJY.P#
and SPJB.J# = SPJX.J#));

Obtener los códigos de los proyectos que utilicen solo partes suministradas por el proveedor S1.

2008-03-01T18:52:00.001Z

Siempre Trabajando sobre esta Base de Datos:
S(S#, Snombre, Situación, Ciudad)
P(P#, Pnombre, Color, Peso, Ciudad)
J(J#, Jnombre, ciudad)
SPJ(S#,P#,J#, Cantidad)

Select Distinct J#
from SPJ, SPJX
where not exists (select P#
from SPJ SPJY
where SPJY.J# = SPJX.J#
and not exists (select *
from SPJ SPJZ
where SPJZ.P# = SPJY.P#
and SPJZ.S#.= ‘S1’));

Obtener los códigos de los proyectos a los cuales se vendan por lo menos todas las partes suministradas por el proveedor S1.

2008-03-01T18:51:00.002Z

Select Distinct J#
from SPJ, SPJX
where not exists (select P#
from SPJ SPJY
where SPJY.S# = ‘s1’#
and not exists (select *
from SPJ SPJZ
where SPJZ.P# = SPJY.P#
and SPJ.J# = SPJX.J#));

Algegra: SPJ [J#, P#] divideby (spj where S# = ‘S1’) [P#]

Obtener los códigos de los proyectos donde se utilice al menos una de las partes suministradas por el suministrador ‘S1’.

2008-03-01T18:51:00.001Z

Siempre Trabajando sobre esta Base de Datos:
S(S#, Snombre, Situación, Ciudad)
P(P#, Pnombre, Color, Peso, Ciudad)
J(J#, Jnombre, ciudad)
SPJ(S#,P#,J#, Cantidad)

Select distinct J#
From SPJ
Where P# in (select P#
From SPJ
Where S# = ‘S1’);
Algebra: (SPJ Join (SPJ where s# = ‘S1’) [P#]) [J#]

Obtener los códigos de los suministradores que suministran la misma parte a todos los proyectos.

2008-03-01T18:50:00.000Z

Siempre Trabajando sobre esta Base de Datos:
S(S#, Snombre, Situación, Ciudad)
P(P#, Pnombre, Color, Peso, Ciudad)
J(J#, Jnombre, ciudad)
SPJ(S#,P#,J#, Cantidad)

Select Distinct S#
From SPJ SPJX
Where exists (select P#
From SPJ SPJY
Where not exists(
Select J#
From J
Where not exists (Select *
From SPJ SPJZ
Where SPJZ.S# = SPJX.S#
And SPJZ.P# = SPJY.P#
And SPJZ.J# = J.J#)));
Algebra: (SPJ [S#, P#, J#] Divide by J[J#]) [S#]

Indique los códigos de los suministradores que venden todas las partes a todos los proyectos.

2008-03-01T18:49:00.002Z

Siempre Trabajando sobre esta Base de Datos:
S(S#, Snombre, Situación, Ciudad)
P(P#, Pnombre, Color, Peso, Ciudad)
J(J#, Jnombre, ciudad)
SPJ(S#,P#,J#, Cantidad)

Select S#
From S
Where not exists (select *
From J, P
Where not exists (select *
From SPJ
Where s.s# = s#
And p.p# = p#
And j.j# = SPJ.J#));
Algebra: SPJ[s#,p#,j#] divibedy (p[p#] times j[j#]) [s#]

Obtener los códigos de los proveedores de Londres que han vendido la misma parte a más de 3 proyectos distintos.

2008-03-01T18:49:00.001Z

Siempre Trabajando sobre esta Base de Datos:
S(S#, Snombre, Situación, Ciudad)
P(P#, Pnombre, Color, Peso, Ciudad)
J(J#, Jnombre, ciudad)
SPJ(S#,P#,J#, Cantidad)

Select distinct S#
From SPJ
Where S# in (Select S#
From S
Where ciudad = “Londres”)
Group by S#, P#
Having count (*) >3

Seleccionar los códigos de los suministradores que han realizado ventas a algún proyecto que totalizan una cantidad superior a la mitad del total de l

2008-03-01T18:48:00.000Z

Siempre Trabajando sobre esta Base de Datos:
S(S#, Snombre, Situación, Ciudad)
P(P#, Pnombre, Color, Peso, Ciudad)
J(J#, Jnombre, ciudad)
SPJ(S#,P#,J#, Cantidad)

Select distinct s#
From SPJ as A
Group By S#, J#
Having sum (cantidad) > (select sum (cantidad)/2
From SPJ
Where J# = A.J#);

Indique las ciudades en las que se fabrican partes no vendidas o bien residen proveedores que no venden nada.-

2008-03-01T18:47:00.002Z

Siempre Trabajando sobre esta Base de Datos:
S(S#, Snombre, Situación, Ciudad)
P(P#, Pnombre, Color, Peso, Ciudad)
J(J#, Jnombre, ciudad)
SPJ(S#,P#,J#, Cantidad)

select ciudad
from p
where not exists (select *
from spj
where p# = p.p#);
union
select ciudad
from s
where not exists (select *
from spj
where s# = s.s#);

Indique las ciudades en las que residen proveedores que venden, al menos, todas las partes fabricadas en la ciudad en la que vive el proveedor.

2008-03-01T18:47:00.001Z

Siempre Trabajando sobre esta Base de Datos:
S(S#, Snombre, Situación, Ciudad)
P(P#, Pnombre, Color, Peso, Ciudad)
J(J#, Jnombre, ciudad)
SPJ(S#,P#,J#, Cantidad)

Select distint ciudad
From S
Where not exists (Select *
From P
Where Ciudad =S.Ciudad
And not exists (Select *
From SPJ
Where SN=S.SN
And PN=P.PN));
(SPJ [S#, P#] divide by (P join S) [ciudad]) join [ciudad]

Indique los códigos de las partes usadas en todos los proyectos.

2008-03-01T18:46:00.000Z

Siempre Trabajando sobre esta Base de Datos:
S(S#, Snombre, Situación, Ciudad)
P(P#, Pnombre, Color, Peso, Ciudad)
J(J#, Jnombre, ciudad)
SPJ(S#,P#,J#, Cantidad)

Select pn
From p
Where not exists (Select *
From j
Where not exists (select *
From spj
Where pn= p.pn
And jn=j.jn));
((SPJ [J#, P#] divide by J[J#] join S) [P#]

Obtener los códigos de los proyectos para los cuales ‘S1’ es el único proveedor de partes rojas.

2008-03-01T18:45:00.002Z

Siempre Trabajando sobre esta Base de Datos:
S(S#, Snombre, Situación, Ciudad)
P(P#, Pnombre, Color, Peso, Ciudad)
J(J#, Jnombre, ciudad)
SPJ(S#,P#,J#, Cantidad)

Select J#
From J
Where not exists (Select *
From SPJ
Where J# = J.J#
And S#<>”S1”
And P# in (Select P#
From P#
Where COLOR=”ROJO”));

Indique los códigos de las partes que han sido vendidas por algún proveedor en una cantidad total mayor de 300.

2008-03-01T18:45:00.001Z

los códigos de los proyectos que solo usan partes fabricadas en telde.

2008-03-01T18:44:00.000Z

Ejercicios de Algebra y Calculo Relacional.
Siempre Trabajando sobre esta Base de Datos:
S(S#, Snombre, Situación, Ciudad)
P(P#, Pnombre, Color, Peso, Ciudad)
J(J#, Jnombre, ciudad)
SPJ(S#,P#,J#, Cantidad)

Select Distinct J#
From SPJ A
Where not exists (select *
From SPJ
Where J#=A.J#
And P# in (select P#
from P
where ciudad <> ‘Telde’)); no usan =
SPJ [J#] minus ((SPJ join P) where ciudad <> ‘Telde’) [J#]

Indicar los códigos de los proveedores que solo venden partes fabricadas en su ciudad

2008-03-01T18:37:00.001Z

Ejercicios de Algebra y Calculo Relacional.
Siempre Trabajando sobre esta Base de Datos:
S(S#, Snombre, Situación, Ciudad)
P(P#, Pnombre, Color, Peso, Ciudad)
J(J#, Jnombre, ciudad)
SPJ(S#,P#,J#, Cantidad)

Select sn
From s
Where not exists (select *
From spj, p
Where spj.pn=p.pn
And sn=s.sn
And ciudad<>s.ciudad);

(s[sn]) minus
((((((s rename ciudad as sciudad)[sn,sciudad]) join (spj[sn,pn])) join (p[pn,ciudad])) where sciudad <>ciudad[sn])

Trabajo Final: Asignatura Dirección Estratégica de Empresas. Analizar la Empresa 3M

2008-02-02T18:30:00.000Z

Trabajo Final de la Asignatura Dirección Estratégica de Empresas, impartida en la Universidad de las Palmas de Gran Canaria. En mi caso, en la carrera de Informática de Gestión.

El trabajo consta de:

1.- Misión y Objetivos
2.- Análisis Externo (Dimensión Socio-Cultural, Dimensión Económica, Dimensión Política-Legal, Dimensión Tecnológica)
3.- Análisis de Entorno Específico (Análisis de la Estructura de la Industria)
4.- Análisis Interno : Recursos (Recursos Tangibles, Recursos Intangibles, Recursos Humanos), Capacidades (Administración y Dirección, Investigación y Desarrollo, Marketing, Recursos Humanos). Análisis DAFO.
5.- Estratégias Competitivas de 3M.

Trabajo Final de Administración y Dirección de Empresas

Especificación Final de un Software.- Trabajo de Ingenieria del Software II, Universidad de las Palmas de Gran Canaria

2008-02-02T18:17:00.000Z

En la siguiente dirección podréis ver el trabajo de la asignatura Ingeniería del Software 2, impartida la carrera de ingenieria técnica de informática de Gestión, en la Universidad de las Palmas de Gran Canaria.

El trabajo consta de:

1.- Especificación Inicial de un Producto Software.
2.- Modelar El Comportamiento del Software.
3.- Analizar las Intenciones de los Usuarios.
4.- Modelo de Casos de Uso (Diagrama de Casos de Usos, UML).
5.- Modelo Conceptual del Software (Diagrama de Clases, UML).
6.- Especificación de los Requisitos del Software.

Trabajo Final de Ingeniería del Software 2

Si no lo pueden ver, me lo pueden perdir a mi correo.

Suma de dos vectores en lenguaje ADA

2008-01-31T19:57:00.000Z

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

2008-01-31T19:55:00.000Z

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

2008-01-31T19:54:00.001Z

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

2008-01-31T19:51:00.000Z

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.

2008-01-31T19:39:00.001Z

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;

Número menor en doble precisión en lenguaje C

2008-01-24T23:18:00.000Z

#include
int main()
{
double min,num; /*Min; guardará el valor del mayor número real, y N el valor más grande de la mantisa*/
int e;
min=1.;
e=0;
num=1.;
while (min>min/2)
{
num=min;
min=min*0.5;
e=e-1;
}

printf("El menor número en simple presición tendrá como exponente %d y será el %e \n", e, num);
return 0;
}

Número menor en simple precisión en lenguaje C

2008-01-24T23:17:00.000Z

#include
int main()
{
float min, min_aux; /* Min_aux; guardará el valor del menor número positivo */
int e,i;
min=1.;
e=0;
i=0;
while (min>min/2) /* hallamos el menor exponente y a la vez calculamos 2 elevado al menor exponente */
{
min_aux=min;
min=min/2;
e=e-1;
}
/*e=e+1;*/
min_aux*= 1./2; /* multiplicamos 2 elevado al menor exponente (min_aux) por la menor mantisa (1/2) */

printf("El menor número en simple presición tendrá como exponente %d y será el %e \n", e, min_aux);
return 0;
}

Número mayor en simple precisión en lenguaje C

2008-01-24T23:16:00.000Z

#include
int main()
{
float max,n,res,aux;/*Max; guardará el valor del mayor número real, y N el valor más grande de la mantisa*/
int e,i;
max=1.;
e=0;
n=0.;
res=1.;
aux=1.;
while (max<2*max) /* aquí hallamos el exponente máximo,multiplicando 1 por 2 hasta que sea infinito*/
{

max=2*max;
e=e+1;
}
for (i=0; i<24; i++) /* hacemos la suma de la mayor mantisa (1/2 + 1/4...+1/2elev 24)*/
{
aux=aux*(1./2);
n=n+aux;
}
for (i=0; i {
res=res*2;
}
res=res*n*2;
printf("El mayor número en simple precisión tendrá como exponente %d y será %e \n", e,res );
return 0;
}

Número mayor en doble precisión en lenguaje C

2008-01-24T23:14:00.000Z

#include
int main()
{
double max,n,res,aux; /*Max; guardará el valor del mayor número real, y N el valor más grande de la mantisa*/
int e,i;
max=1.;
e=0;
n=0.;
res=1.;
aux=1.;
while (max<2*max)
{
max=2*max;
e=e+1;
}
for (i=0; i<53; i++)
{
aux=aux*(1./2);
n=n+aux;
}
for (i=0; i {
res=res*2.;
}
res=res*n*2.;
printf("El mayor número en doble precisión tendrá como exponente %d y será %e \n", e, res );
return 0;
}

Método Newton Raphson en lenguaje C (solo)

2008-01-24T23:13:00.000Z

#include
#include
#define CERO 0.000000001

/*Funcion que queremos aproximar*/
float f(float x){
return (x*x*x*x*x)+(x*x)-9;
}

/*Derivada de la función a aproximar*/
float df(float x){
return (5*(x*x*x*x)+2*x);
}

float Newton_Rapson(float p, float tol, int n){
int i=0;
float np;
np=p;

if(fabs(df(p))>CERO)
p = p-(f(p)/df(p));

while ((fabs(np-p) > tol) && (fabs(f(p)) > CERO) && (i i++;
np=p;
if(fabs(df(p))>CERO)
p =p-(f(p)/df(p));
}

if (i==n)
printf("\nSe alcanzo el numero maximo de iteraciones.\n");

return(p);
}

int main()
{
float sol;
sol=Newton_Rapson(1.5, 0.001, 50);
printf("\nLa solucion a Newton-Raphson es la raiz: %f\n", sol);
return 0;
system ("pause");
}

Método de Simpson en lenguaje C

2008-01-24T23:12:00.000Z

#include
#include
#include

double potencia(double x, int grado) /*Calcula el cuadrado de cada uno de los componentes del vector*/
{
double resultado=1.;
int i;
if(grado==0)
return resultado;
else
{
for(i=0;i resultado = resultado*x;

}
return resultado;
}

double f(double *coef,double x,int grado)/*Aqui se calcula el valor de la funcion*/
{
int i;
double res = 0.;
for(i=0;i<=grado;i++)
res = res + coef[i]*potencia(x,i);
return res;
}

double simpson(double *coef,int grado,double x,double x1)
{
int i;
double n=100,lim,xm,simp=0.;
lim = x1-x; /*Limsup-Liminf*/
xm = lim/n;/*Lo dividimos para dividir el integral en subintegrales*/

for (i=0;i simp = simp + (f(coef,x+i*xm,grado)+f(coef,x+(i+1)*xm,grado)+4*f(coef,x+(i+0.5)*xm,grado))/6*xm;
return simp;
}
int main(){
double res, *vec;
double linf,lsup,com;
int i,tam=0;
printf("\t---------------------------------------------\n");
printf("\t| METODO DE SIMPSON |\n");
printf("\t---------------------------------------------\n");
printf("\nIntroduzca el grado del polinomio:");
scanf("%d",&tam);
vec=(double*)malloc(tam*sizeof(double));
for (i=tam;i>=0;i--)
{
printf("Introduzca el valor del coeficiente de x%d: ",i);
scanf("%lf",&com);
vec[i]=com;
}
printf("\nIntroduzca los limites del integral:");
printf("\nLimite inferior (xk):");
scanf("%lf",&linf);
printf("Limite superior (xk+1):");
scanf("%lf",&lsup);
res = simpson(vec,tam,linf,lsup);

printf("\n El Resultado de la integral es: %lf",res);
return 0;
}

Calculo de Secante en lenguaje C

2008-01-24T23:11:00.000Z

#include
#include
#define CERO 0.000001

float f(float x){
return (x*x)-2.0;
}

float df(float x0,float x1){

return ((f(x1)-f(x0) )/ (x1-x0) );
}
/*****************************************************/
float Secante(float p0, float p1 , float tol, int n){
int i=0;
float p,q0,q1;

q0=f(p0);
q1=f(p1);

while ((fabs(p1-p0) > tol) && (fabs(f(p)) > CERO)) {
i++;

p = p1- q1*(p1-p0)/(q1-q0);

if( fabs(p-p1) > CERO )
return p;

p0=p1;
q0=q1;
p1=p;
q1=f(p);

}
printf("el n de iteraciones es %d\n", i);
return(p);
}

/**********************************************************/

int main()
{
printf("La solucion es: %.16e\n\n", Secante(-2.0 , 2.0, 0.000001,10));
return 0;
}

Método Regula Falsi en lenguaje C

2008-01-24T23:10:00.000Z

#include
#include

#define Cero 0.00001
float f(float x){
return ((x*x*x)-2);
}

float Regual_falsi (float a,float b, float tol){
float c = a - ( (b-a)/ (f(b)-f(a)) )*f(a);
int i=0;

while ( (f(c) != Cero) && ( fabs(b-a) > tol )&& i<10 ){

if (f(a) * f(c) < Cero)
b=c;
else
a=c;

c = a - ( (b-a)/ (f(b)-f(a)) )*f(a);
i++;}

return c;
}
int main(){

printf("el valor de la raiz es: %f \n", Regual_falsi (-2.0, 2.0, 0.000001 ) );
return 0;
}

Método de Muller en lenguaje C

2008-01-24T23:08:00.000Z

#include
#include
#include "complejo.h"
#define CERO 0.00000001

fcomplex f(fcomplex x){
return Cadd(Cmul(x,Cmul(x,x)),Complex(-27.,0.));/*x^3 -27*/
}

fcomplex df(fcomplex x){
return RCmul(3.,Cmul(x,x));/*3x^2*/
}
/****************************Newton Rapson***********************************/

fcomplex Newton_Rapson(fcomplex p, float tol, int n){
int i=0;
fcomplex np;
np=p;
p = Csub(p, Cdiv(f(p),df(p)) );

while ((Cabs(Csub(np,p)) > tol) && (Cabs(f(p)) > CERO) && (i i++;
np=p;

if(Cabs(df(p))>CERO)
p =Csub(p,Cdiv(f(p),df(p)));

}
if (i==n)
printf("NEWTON HA EXEDIDO EL NUMERO DE ITERACIONES");
return(p);
}

/**********************calculo de la segunda derivada***********************/

fcomplex d2 (fcomplex aprox1, fcomplex aprox2,fcomplex aprox3)

{
fcomplex a,b,c;
if ( (Cabs(Csub(aprox2,aprox1)) > CERO) && (Cabs(Csub(aprox3,aprox2)) > CERO) ) {
a = Cdiv(Csub(f(aprox2),f(aprox1)),Csub(aprox2,aprox1));
b = Cdiv(Csub(f(aprox3),f(aprox2)),Csub(aprox3,aprox2));
c = RCmul(2.0,(Cdiv(Csub(a,b),Csub(aprox1,aprox3)))); }
else
printf("\nDIVISION POR CERO EN DERIVADA SEGUNDA\n");
return c;
}

/*definicion de la primera derivada discretizadas*/

fcomplex d1 (fcomplex aprox1, fcomplex aprox2, fcomplex aprox3)

{
fcomplex a,b,c;
if (Cabs(Csub(aprox3,aprox2)) > CERO )
a = Cdiv(Csub(f(aprox3),f(aprox2)),Csub(aprox3,aprox2));
else
printf("\nDIVISION POR CERO EN DERIVADA PRIMERA\n");
b = Cmul(RCmul(0.5,d2(aprox1,aprox2,aprox3)),Csub(aprox3,aprox2));
c = Cadd(a,b);
return c;
}

/***********************calculo de la raiz cuadrada*************************/

fcomplex Msqrt (fcomplex x1, fcomplex x2, fcomplex x3){

return Csqrt( Csub ( Cmul(d1(x1,x2,x3),d1(x1,x2,x3)) , Cmul( RCmul (2,d2(x1,x2,x3)), f(x3) ) ));
}

/***********************funcion Muller****************************/

fcomplex muller (fcomplex x0, fcomplex x1, fcomplex x2, float tol, int iter){

fcomplex raiz_pos, raiz_neg;
int i=0;

while ( ( Cabs(Csub(x1,x2)) > tol) && (iCERO) ){

if (Cabs(d2(x0,x1,x2)) > CERO){
raiz_pos = Cdiv( Cadd(RCmul(-1.,d1(x0,x1,x2)) ,Msqrt(x0,x1,x2)) ,d2(x0,x1,x2)) ;
raiz_neg = Cdiv( Csub(RCmul(-1.,d1(x0,x1,x2)) ,Msqrt(x0,x1,x2)) ,d2(x0,x1,x2)) ;

if (Cabs(raiz_pos) > Cabs(raiz_neg)){
x0=x1;
x1=x2;
x2=Cadd(raiz_neg,x2); }
else{
x0=x1;
x1=x2;
x2=Cadd(raiz_pos,x2); }
}
else{
printf("\nSOLUCION NEWTON RAPSON\n");
return Newton_Rapson(x0, tol, iter);}
i++;
}
if (i>=iter)
printf("\nMULLER HA EXEDIDO EL NUMERO DE ITERACIONES\n");

return x2;
}

/**************************************************************************************/

int main(){

fcomplex s;

s= muller ( Complex(0.01,0.), Complex(0.1,0.), Complex(1.,0.) ,0.000001, 1000);
printf("\nLa raiz buscada es: (%f,%f)\n\n", s.r,s.i);
return 0;
}

// complejo.h

#include
#include

#ifndef _FCOMPLEX_DECLARE_T_
typedef struct {float r,i;} fcomplex; /* type for a complex no */
#define _FCOMPLEX_DECLARE_T_
#endif /* _FCOMPLEX_DECLARE_T_ */

/* function prototypes */
/***********************/
fcomplex Cadd( fcomplex a, fcomplex b);
fcomplex Csub( fcomplex a, fcomplex b);
fcomplex Cmul( fcomplex a, fcomplex b);
fcomplex Complex( float re, float im);
fcomplex Conjg( fcomplex z);
fcomplex Cdiv( fcomplex a, fcomplex b);
float Cabs( fcomplex z);
fcomplex Csqrt( fcomplex z);
fcomplex RCmul( float x, fcomplex a);
fcomplex Cinv( fcomplex z);

// complejo.c

#include "complejo.h"

fcomplex Cadd(fcomplex a, fcomplex b)
{
fcomplex c;

c.r=a.r+b.r;
c.i=a.i+b.i;
return c;
}

fcomplex Csub(fcomplex a, fcomplex b)
{
fcomplex c;
c.r=a.r-b.r;
c.i=a.i-b.i;
return c;
}

fcomplex Cmul(fcomplex a, fcomplex b) /* Using only 3 multiplications! */
{
fcomplex c;
float t1,t2;

t1=a.r*b.r;
t2=a.i*b.i;

c.r=t1-t2;
c.i=(a.r+a.i)*(b.r+b.i)-(t1+t2);
return c;
}

fcomplex Complex(float re, float im)
{
fcomplex c;
c.r=re;
c.i=im;
return c;
}

fcomplex Conjg(fcomplex z)
{ fcomplex c;
c.r=z.r;
c.i = -z.i;
return c;
}

fcomplex Cdiv(fcomplex a, fcomplex b)
{
fcomplex c;
float r; float den;

if (fabs(b.r) >= fabs(b.i)) {
r=b.i/b.r;
den=b.r+r*b.i;
c.r=(a.r+r*a.i)/den;
c.i=(a.i-r*a.r)/den;
}
else {
r=b.r/b.i;
den=b.i+r*b.r;
c.r=(a.r*r+a.i)/den;
c.i=(a.i*r-a.r)/den;
}
return c;
}

float Cabs(fcomplex z)
{
float x,y,ans,temp;
x=fabs(z.r);
y=fabs(z.i);
if (x == 0.0)
ans=y;
else if (y == 0.0)
ans=x;
else if (x > y) {
temp=y/x;
ans=x*sqrt(1.0+temp*temp);
}
else {
temp=x/y;
ans=y*sqrt(1.0+temp*temp); }
return ans;
}

fcomplex Csqrt(fcomplex z)
{
fcomplex c;
float w;
if ((z.r == 0.0) && (z.i == 0.0)) {
c.r=0.0;
c.i=0.0;
}
else {
w = sqrt((sqrt(z.r*z.r + z.i*z.i) + fabs(z.r)) * 0.5);
if (z.r >= 0.0){
c.r=w;
c.i=z.i/(2.0*w);
}
else {
c.i=(z.i >= 0) ? w : -w;
c.r=z.i/(2.0*c.i);
}
}
return c;
}

fcomplex RCmul(float x, fcomplex a)
{
fcomplex c;
c.r=x*a.r;
c.i=x*a.i;
return c;
}

fcomplex Cinv( fcomplex z)
{
fcomplex c;
float s = 1.0 / (z.r*z.r + z.i*z.i);

c.r = z.r * s;
c.i = -z.i * s;
return c;
}

/* int main()
{
fcomplex a, b, c;

a = Complex( 10, 6 );
b = Complex( 4, 9 );

c = Cadd( a, b );
printf( "Suma: (%f,%f)\n", c.r, c.i );
c = Csub( a, b );
printf( "Resta: (%f,%f)\n", c.r, c.i );
c = Cmul( a, b );
printf( "Producto: (%f,%f)\n", c.r, c.i );
c = Cdiv( a, b );
printf( "Divisin: (%f,%f)\n", c.r, c.i );
} */

Método de Relajación en lenguaje C

2008-01-24T23:07:00.001Z

#include
#include
#include

double** LeerDatos(char *nombrefichero,int *dimension)
{
double **matriz;
int i,j;
FILE *f;
if(f=fopen(nombrefichero,"r"),!f)
{
printf("Problema con la lectura del fichero\n");
return matriz;
}
fscanf(f,"%d\n",&(*dimension));
/* Asignacion de memoria dinamica*/
matriz=(double**)malloc(*dimension*sizeof(double*));
for(i=0;i<*dimension;i++)
{
matriz[i]=(double*)malloc((*dimension+1)*sizeof(double));
}
/* Lectura de elementos de la matriz*/
for(i=0;i<*dimension;i++)
{
for(j=0;j<*dimension;j++)
{
fscanf(f,"%lf\n",&(matriz[i][j]));
}
}
/* Leemos el vector de terminos independientes */
for(i=0;i<*dimension;i++)
{
fscanf(f,"%lf\n",&(matriz[i][*dimension]));
}
fclose(f);
return matriz;
}

/* Procedimiento para mostrar matrices */
void muestra(double **matriz,int Tam)
{
int i,j;
printf("\n\t");
for(i=0;i {
for(j=0;j {
printf("%lf ",matriz[i][j]);
}
printf("\n\t");
}
printf("\n");
}
/* Procedimiento que multiplica matrices */
double** mulmat(double **A, double **B,int dimension)
{
int i,j,k;
double **C=(double**)malloc(dimension*sizeof(double*));

for(i=0;i {
C[i]=(double*)malloc((dimension)*sizeof(double));
}
for(i=0;i {
for(j=0;j {
C[i][j]=0;
}
}
for (i=0;i {
for (j=0;j {
for (k=0;k {
C[i][j]=C[i][j]+(A[i][k]*B[k][j]);
}
}
}
return (C);
}
/* funcion que construye la matriz de Jacobi Mj*/
double** MJ(double **matriz,int dimension)

{
int i,j;
double **mj,**L_U,**Dinv;
/* Tomamos memoria */
L_U=(double**)malloc(dimension*sizeof(double*));
Dinv=(double**)malloc(dimension*sizeof(double*));
for(i=0;i {
L_U[i]=(double*)malloc((dimension)*sizeof(double));
Dinv[i]=(double*)malloc((dimension)*sizeof(double));
}
/* calculamos inv(D), y L_U=-L-U*/
for(i=0;i {
for(j=0;j {
if (j==i)
{
Dinv[i][j]=1/matriz[i][j];
L_U[i][j]=0;
}
else
{
Dinv[i][j]=0;
L_U[i][j]=(-1)*matriz[i][j];
}
}
}
/* mj=inv(d)*(-L-U)*/
mj=mulmat(Dinv,L_U,dimension);
free(L_U);
free(Dinv);
return (mj);
}
double norma(double *vec,int dimension,int Tnorma)
{
int i,cero=0.00000000001;
double temp=0;
if (Tnorma==1)
{/*Norma ecuclidea*/
for(i=0;i {
temp+=vec[i]*vec[i];
}
return sqrt(temp);
}
else
{/*Norma infinita*/
temp=fabs(vec[0]);
for (i=1;i {
if ((fabs(vec[i])-fabs(temp)) > cero)
temp=fabs(vec[i]);
}
return temp;
}
}

/* Devuelve el signo del autovalor*/
double sign(double *v1, double *v2, int dimension)
{
int i;
double temp=0;

for (i=0; i {
temp = temp + v1[i] * v2[i];
}
if (temp>=0)
return (1);
else
return (-1);
}

/* Multiplica una matriz por un vector*/
double* MatxVec(double** matriz,double* vec,int dimension)
{
int i,j;
double *sol=(double*)malloc(dimension*sizeof(double));

for (i=0;i {
sol[i]=0;
for (j=0;j {
sol[i]= sol[i] + matriz[i][j]*vec[j];
}
}
return sol;
}

double Potencia(double **matriz,int dimension,double *u_n,double tolerancia,int Nmax)
{
double* temp=(double*)malloc(dimension*sizeof(double));
double* u_n_1=(double*)malloc(dimension*sizeof(double));
double Norma,Norma_Anterior=0,solucion;
int n=1,j;

Norma=norma(u_n,dimension,1);
while((n<=Nmax)&&(fabs(Norma-Norma_Anterior)>tolerancia))
{
/*Guardamos la iteracion anterior*/
for (j=0;j {
u_n_1[j]=u_n[j];
}
/*Dividimos entre la norma la iteracion actual*/
for (j=0;j {
u_n[j]=u_n[j]/Norma;
}
/* Y resolvemos la iteracion siguiente*/
temp = MatxVec(matriz,u_n,dimension);
free(u_n);
u_n=temp;
Norma_Anterior=Norma;
/* Hallamos el signo del autovalor maximo*/
solucion=Norma*sign(u_n, u_n_1, dimension);
n=n+1;
Norma=norma(u_n,dimension,1);
}
if (n>Nmax)
printf("Se ha superado el numero de iteraciones maximo.\n");
free(u_n_1);
free(temp);
return (solucion);
}

void relajacion(double **matriz,double *b,double *u_n,int dimension,int Nmax,double w,double Tol)
{
double dif,temp,maxdif=1.;
double *anterior;
int i,j,k,n=1;

anterior=(double*)malloc(dimension*sizeof(double));
while((n<=Nmax)&&(maxdif>Tol)) /*Bucle para calcular las aproximaciones hasta el valor numero de iteraciones*/
{
printf(" u%d[ ",n);
for (i=0;i {
printf(" %lf",u_n[i]);
anterior[i]=u_n[i]; /*guardamos en el vector anterior la posicion anterior del vector de aproximacion*/
}
printf("]\n");

/*Calculamos la siguiente iteracion*/
for (i=0;i {
temp=0;
for (j=0;j {
if (i!=j)
{
temp=temp-(matriz[i][j]*u_n[j]);
}
}
u_n[i]=w*( (temp + b[i]) / matriz[i][i])+((1-w)*u_n[i]); /*Aqui se almacena la siguiente aprox obtenida*/
}
/*Calculamos la mayor diferencia para el calculo del error*/
maxdif=fabs(u_n[0]-anterior[0]);
for (k=1;k {
dif=fabs(u_n[k]-anterior[k]);
if (dif>maxdif)
{
maxdif=dif;
}
}
n++;
}
if (n>Nmax)
printf("Se ha superado el numero de iteraciones maximo.\n");
free(anterior);
}

int main()
{
int dimension,Nmax,i,j;
double Tol,wopt;
double **matriz,**Mj,*u,*b;

printf("\t---------------------------------------------\n");
printf("\t| METODO DE RELAJACION |\n");
printf("\t---------------------------------------------\n");
printf("\n Introduzca tolerancia: ");
scanf("%lf",&Tol);
printf(" Introduzca el numero maximo de iteraciones: ");
scanf("%i",&Nmax);

matriz=LeerDatos("matriz4.dat",&dimension);
u=(double*)malloc(dimension*sizeof(double));/*Vector de aproximaciones iniciales*/
b=(double*)malloc(dimension*sizeof(double));/*Vector de terminos independientes*/
printf(" Terminos independientes: ");
printf("\n b[");
for(i=0;i {
b[i]=matriz[i][dimension];
printf(" %lf",b[i]);
}
printf(" ]\n");
printf("\n La matriz de coeficientes es: \n\n");

for (i=0;i {
printf("{ ");
for (j=0;j {
printf("%4.3f ",matriz[i][j]);
}
printf("}\n");
}

/*Aplicamos el Metodo de la Potencia para despues calcular el Wopt.\n");*/
printf("\n Calculamos Mj=ind(D)(-L-U): \n");
Mj=MJ(matriz,dimension); /* Calculamos Mj=inv(D)(-L-U)*/
printf(" La matriz Mj da: \n");
muestra(Mj,dimension);
printf(" Introduce el vector de aproximacion inicial para el metodo de la potencia:\n");
for (i=0;i {
printf(" U[%d]=",i);
scanf("%lf",&(u[i]));
}

wopt=Potencia(Mj,dimension,u,Tol,Nmax); /* Calculamos el autovalor maximo*/

wopt=(2/(1+sqrt(1-(wopt*wopt))));/* Calculamos el w optimo*/

printf(" El Wopt es: %lf \n",wopt);
printf(" Aplicamos Relajacion.\n");
printf(" Introduce el vector de aproximacion inicial para el metodo de Relajacion:\n");

u=(double*)malloc(dimension*sizeof(double));
for (i=0;i {
printf(" U[%d]=",i);
scanf("%lf",&(u[i]));
}
/* Aplicamos relajacion */
relajacion(matriz,b,u,dimension,Nmax,wopt,Tol); /*procedure q nos devuelve de salida u*/
printf("\n El resultado[");
for(i=0;i {
printf(" %lf",u[i]);
}
printf(" ]\n");
return 0;
}

Método de Jacobi Mj_Cj en lenguaje C

2008-01-24T23:05:00.001Z

Método de Horner en Lenguaje C

2008-01-24T23:04:00.000Z

#include
#include
#include

int Exponencial(float x0,int aux2){
float product;
product = 1.00;

while ((aux2)!=0){
product *= x0;
aux2--;
}
return product; /*de aqui sale el cuadrada de cada*/
}

float Horner (float x0,float *P, int N){
float *Q,aux,a;
int i,j,product;

aux = 0.00;

Q= (double*)malloc(N*sizeof(double)); /*reservamos la memoria para el vector*/

for (i=N-1;i>=0;i--){
if (i==N-1)
Q[i] = P[i]; /*bn=an*/
else
Q[i] = P[i] + (Q[i+1]*x0); /*bk=ak+ bk+1*x */

}

printf("{ ");

for ( i=0;i printf("-%f",Q[i]);
printf("} ");

j = 0;
for (i=N-1;i>=0;i--){

if (i!=0)

aux += Q[i]*Exponencial(x0,N-1-j-1);/*te calcula las b para poder multiplicarlo*/
/* a=Exponencial(x0,N-1-j-1);*/
printf("da:%f\n",aux);
j++;
}
printf ("E valor numerico del polinomio es:%f\n", aux);
return 0.00;
}
int main(){
float P[5]={-61.0,50.00,-48.00,16.00,3.00};
Horner (3,P, 5);

return 0;

}

Método de Gauss-Jacobi en Lenguaje C

2008-01-24T23:03:00.000Z

Método de Gauss-Seidel en Lenguaje C

2008-01-24T23:02:00.000Z

Método de Gauss-Seidel en Lenguaje C (Mj_CJ)

2008-01-24T22:59:00.000Z

#include
#include
#include
#define TOL 0.00001

double** LeerDatos(char *nombrefichero,int *dimension)
{
double **matriz;
int i,j;
FILE *f;

if(f=fopen(nombrefichero,"r"),!f){
printf("Problema con la lectura del fichero\n");
return matriz;
}
fscanf(f,"%d\n",&(*dimension));

/* Asignacion de memoria dinamica*/
matriz=(double**)malloc(*dimension*sizeof(double*));
for(i=0;i<*dimension;i++)
matriz[i]=(double*)malloc((*dimension+1)*sizeof(double));

for(i=0;i<*dimension;i++)
for(j=0;j<*dimension;j++)
fscanf(f,"%lf\n",&(matriz[i][j]));

for(i=0;i<*dimension;i++)
fscanf(f,"%lf\n",&(matriz[i][*dimension]));

fclose(f);
return matriz;
}

void liberaMatriz(double **matriz,int dimension){
int i;

for(i=0;i free(matriz[i]);
free(matriz);
}

double **multiplica(double **A,double **B,int dimension){
int i,j,k;
double **C;
C=(double**)malloc(dimension*sizeof(double*));
for(i=0;i C[i]=(double*)malloc((dimension+1)*sizeof(double));

for (i=0;i for (j=0;j for (k=0;k C[i][j]=C[i][j]+A[i][k]*B[k][j];
return C;
}

double **matrizAmpliada(double **matriz,double *vector,int dimension){
int i,j;
double **C;
C=(double**)malloc(dimension*sizeof(double*));
for(i=0;i C[i]=(double*)malloc((dimension+1)*sizeof(double));

for (i=0;i for (j=0;j C[i][j]=matriz[i][j];

for (i=0;i C[i][dimension]=vector[i];
return C;
}
double *matrizPorVector(double **matriz,double *vector,int dimension){
double *resultado,a,b,mult;
int i,j;

resultado=(double*)malloc(dimension*sizeof(double));

for(i=0;i mult=0;
for(j=0;j mult+=(matriz[i][j]*vector[j]);
resultado[i]=mult;
}

return resultado;
}

double* resolverSistemaGauss(double **A,double *b,int dimension){ /*funcion q la usa inversa*/
double M,t,*X,suma,**aux;
int i,j,p,k,c,*Fila;

Fila=(int*)malloc(dimension*sizeof(int*));
X=(double*)malloc(dimension*sizeof(double));

aux=(double**)malloc(dimension*sizeof(double*));
for(i=0;i aux[i]=(double*)malloc((dimension+1)*sizeof(double));

for(i=0;i for(j=0;j aux[i][j]=A[i][j];

aux=matrizAmpliada(aux,b,dimension);

for(j=0;j Fila[j]=j;

for(p=0;p for(k=p+1;k if(fabs(aux[Fila[k]][p])>(fabs(aux[Fila[p]][p]))){
t=Fila[p];
Fila[p]=Fila[k];
Fila[k]=t;
}

if(fabs(aux[Fila[p]][p]) < TOL){
printf("\n\n\"resolverSistemaGauss\" informa:\n");
printf("La matriz es singular\n");
return NULL;
}

for(k=p+1;k M=(aux[Fila[k]][p])/(aux[Fila[p]][p]);
for(c=p;c<=dimension;c++)
aux[Fila[k]][c]=(aux[Fila[k]][c])-(M*aux[Fila[p]][c]);
}
}

if(fabs(aux[Fila[dimension-1]][dimension-1]) < TOL){
printf("\n\n\"resolverSistemaGauss\" informa:\n");
printf("La matriz es singular\n");
return NULL;
}

X[dimension-1]=aux[Fila[dimension-1]][dimension]/(aux[Fila[dimension-1]][dimension-1]);

for(k=dimension-2;k>=0;k--){
suma=0.;
for(c=dimension-1;c>k;c--)
suma+=X[c]*aux[Fila[k]][c];
X[k]=(aux[Fila[k]][dimension]-suma)/aux[Fila[k]][k];
}
return X;
}

double **inversa(double **A,int dimension){
double **invA,*C,**aux,*b;
int i,j;

b=(double*)malloc((dimension)*sizeof(double));

invA=(double**)malloc(dimension*sizeof(double*));
for(i=0;i invA[i]=(double*)malloc((dimension)*sizeof(double));

aux=(double**)malloc(dimension*sizeof(double*));
for(i=0;i aux[i]=(double*)malloc((dimension+1)*sizeof(double));
for(i=0;i for(j=0;j aux[i][j]=A[i][j];

for(i=0;i for(j=0;j if (j==i)
b[j]=1;
else
b[j]=0;
}

if (C=resolverSistemaGauss(aux,b,dimension))
for(j=0;j invA[j][i]=C[j];
else
return NULL;
}
liberaMatriz(aux,dimension);
return invA;
}

double *suma_vector(double *A,double *B,int dimension){

int i;
double *C;

C=(double*)malloc(dimension*sizeof(double));

for (i=0;i C[i] = A[i]+B[i];

return C;
}

void Gauss_Seidel_2 (double **m, double *v, double *aprox, int dimension, int iter){
double **DL, **U, *C;
int i,j;

DL=(double**)malloc(dimension*sizeof(double*));
for(i=0;i DL[i]=(double*)malloc((dimension)*sizeof(double));

U=(double**)malloc(dimension*sizeof(double*));
for(i=0;i U[i]=(double*)malloc((dimension)*sizeof(double));

/*Hallamos la matriz D + L */

for (i=0;i for(j=0;j if (j>i)
DL[i][j] = 0.;
else
DL[i][j] = m[i][j];

/*Hallamos la inversa de D+L*/

DL = inversa(DL, dimension);

/*Obtenemos la matriz -U*/

for (i=0;i for(j=0;j if (j>i)
U[i][j] = -m[i][j];
else
U[i][j] = 0.;

/*OBTENEMOS LA MATRIZ DE GAUSS SEIDEL Mj*/

liberaMatriz(m,dimension);
m = multiplica(DL, U, dimension);
printf("\La matriz Mgs da: \n\n");

for (i=0;i {
printf("{ ");
for (j=0;j {
printf("%4.3f ",m[i][j]);
}
printf("}\n");
}

/*CALCULAMOS EL VECTOR Cj*/
C=matrizPorVector(DL,v,dimension);
printf("\nEl vector C da: \n");
for (j=0;j {
printf(" %4.3f ",C[j]);
}

for(i=0;i aprox = matrizPorVector(m,aprox,dimension);
aprox = suma_vector(aprox, C, dimension);}

printf("\nEl vector solucion para ese numero de iteraciones es:\n");
for(i=0;i printf("\nvector Un[%d] = %lf",i,aprox[i]);
liberaMatriz(m,dimension);
liberaMatriz(U,dimension);
liberaMatriz(DL,dimension);

}

int main(){

double **matriz;
double *v, *aprox, aux;
int dimension, iter, i, j;

matriz=LeerDatos("matriz4.dat",&dimension);

printf("\t---------------------------------------------\n");
printf("\t| METODO DE GAUSS-SEIDEL_MC |\n");
printf("\t---------------------------------------------\n");

v = (double*)malloc(dimension*sizeof(double));
aprox = (double*)malloc(dimension*sizeof(double));

printf("\n La matriz de coeficientes es: \n\n");

for (i=0;i {
printf("{ ");
for (j=0;j {
printf("%4.3f ",matriz[i][j]);
}
printf("}\n");
}

for (i=0;i v[i] = matriz[i][dimension];

printf("\nIntroduzca la aproximacion inicial:\n");
for(i=0;i scanf("\n%f", &aux);
aprox[i] = aux;}

printf("\nIntroduzca el numero de interaciones deseado:\n");
scanf("%d",&iter);

Gauss_Seidel_2 (matriz, v ,aprox, dimension, iter);

/* destruimos los vectores de punteros */
/*la matriz ya la libero arriba en gauss*/
free(v);
free(aprox);

return 0;

}

Método de Crout en lenguaje C

2008-01-24T22:51:00.000Z

//principal.c

#include
#include
#include
#include "matrices.h"
#include "crout.h"

void captura_matriz(double **mat,int nfil,int ncol)
{
int i,j;
double valor;

for (i=0;i {
for (j=0;j {
printf("introduzca el valor[%d,%d]=",i,j);
scanf("%f",&valor);
mat[i][j]=valor;

}
}}
void muestra_matriz (double **mat,int nfil,int ncol)
{
int i,j;

for (i=0;i {
printf("{ ");
for (j=0;j {
printf("%4.3f ",mat[i][j]);
}
printf("}\n");
}
}
int main()

{
double **matriz,**matriz_u,**matriz_l,*vect,*termindp;
FILE *fich;
int i,j,tam;
/*apertura de fichero, devolviendo el tamaÃ±o de la matriz*/
tam = abrirFicheroMatriz("matriz4.dat",&fich);

/*se reserva para las matrices vectores de punteros a double que serÃan las filas (i)*/
matriz_u = (double**)malloc(tam*sizeof(double*));
matriz_l = (double**)malloc(tam*sizeof(double*));
vect = (double*)malloc(tam*sizeof(double));
termindp = (double*)malloc(tam*sizeof(double));
/*una vez reservadas las filas se reservan para cada puntero del vector un vector que seran
las columnas*/
for(i=0;i matriz_u[i]=(double*)malloc(tam*sizeof(double));
matriz_l[i]=(double*)malloc(tam*sizeof(double));
}
printf("\t---------------------------------------------\n");
printf("\t| METODO DE CROUT |\n");
printf("\t---------------------------------------------\n");

/*Se procedera en primer lugar a descomponer la matriz A, en matriz B y matriz B'\n");
usando para ello el metodo de Crout.\n");
Se realizara el descenso y el remonte de las misma, obtiendo asi las soluciones del sistema\n\n");*/

matriz=leerDatos(fich,tam);
/*se lee la matriz A y se muestra*/
printf("La matriz de coeficientes es: \n ");
muestra_matriz(matriz,tam,tam);

crout(matriz,matriz_u,matriz_l,tam);
/*una vez hallado B y B' o L y U son mostradas por pantalla*/

printf("\n\n El metodo de Crout concluido con exito \n");
printf("\nEsta son las dos matrices obtenidas : ");

printf("\nMatriz B' : \n ");
muestra_matriz(matriz_l,tam,tam);
printf("\nmatriz B: \n ");
muestra_matriz(matriz_u,tam,tam);
/*vector de terminos independientes*/

printf("Vector de terminos independientes :\n");
for(i=0;i {
printf("\n");
termindp[i]=matriz[i][tam];
printf("( %4.3lf )", termindp[i]);
}
printf("\n");
vect =descenso(matriz_l,termindp,tam);
vect =remonte(matriz_u,vect,tam);
printf("La resolucion del sistema de ecuaciones a concluido con exito, las soluciones son: ");
printf("\n");
for(i=0;i printf("( %4.3lf )", vect[i]);
printf("\n");
for(i=0; i {
free(matriz[i]);
free(matriz_l[i]);
free(matriz_u[i]);
}

/* destruimos losvectorres de punteros */
free(matriz);
free(matriz_l);
free(matriz_u);
free(vect);
free(termindp);
return 0;
}

//matrices.h
#ifndef MATRICES_DEF
#define MATRICES_DEF

/*--------------------------------------------------------------------------------*/
/* devuelve la matriz resultante de A*B */
double **multiplica(double **A,double **B,int dimension);
/*--------------------------------------------------------------------------------*/

/*--------------------------------------------------------------------------------*/
/* devuelve la matriz resultante de A*x, siendo x un vector */
double *matrizPorVector(double **matriz,double *vector,int dimension);
/*--------------------------------------------------------------------------------*/

/*--------------------------------------------------------------------------------*/
/* devuelve la matriz resultante de A+B */
double **suma(double **A,double **B,int dimension);
/*--------------------------------------------------------------------------------*/

/*--------------------------------------------------------------------------------*/
/* devuelve la matriz resultante de A-B */
double **resta(double **A,double **B,int dimension);
/*--------------------------------------------------------------------------------*/

/*--------------------------------------------------------------------------------*/
/* Le resta a la diagonal el autovalor pasado */
/* si se le pasa la matriz ampliada solo devulve la matriz */
/* sin la columna de terminos independientes */
double **matrizMenosAutovalor(double **matriz,double autovalor,int dimension);
/*--------------------------------------------------------------------------------*/

/*--------------------------------------------------------------------------------*/
/* devuelve el vector de terminos independientes de la matriz ampliada */
double *terminosIndependientes(double **matriz,int dimension);
/*--------------------------------------------------------------------------------*/

/*--------------------------------------------------------------------------------*/
/* crea una matriz ampliada pasandole una matriz y */
/* el vector de terminos independientes */
double **matrizAmpliada(double **matriz,double *vector,int dimension);
/*--------------------------------------------------------------------------------*/

/*--------------------------------------------------------------------------------*/
/* devuelve la matriz traspuesta de una matriz de entrada */
double **traspuesta(double **A,int dimension);
/*--------------------------------------------------------------------------------*/

/*--------------------------------------------------------------------------------*/
/* devuelve el vector de soluciones obtenidas al realizar
el descenso en una matriz triangular superior */
double *remonte(double **B,double *b,int dimension);
/*--------------------------------------------------------------------------------*/

/*--------------------------------------------------------------------------------*/
/* devuelve el vector de soluciones obtenidas al realizar
el descenso en una matriz triangular inferior */
double *descenso(double **B,double *b,int dimension);
/*--------------------------------------------------------------------------------*/

/*--------------------------------------------------------------------------------*/
/* comprueba si una matriz es simetrica */
/* 1: SI es simetrica */
/* 0: NO es simetrica */
int simetrica(double **A,int dimension);
/*--------------------------------------------------------------------------------*/

/*--------------------------------------------------------------------------------*/
/* comprueba si dos matrices son iguales */
/* 1: SI son iguales */
/* 0: NO son iguales */
int iguales(double **A,double **B,int dimension);
/*--------------------------------------------------------------------------------*/

/*--------------------------------------------------------------------------------*/
/* comprueba si una matriz es tridiagonal */
/* 1: SI es tridiagonal */
/* 0: NO es tridiagonal */
int tridiagonal(double **A,int dimension);
/*--------------------------------------------------------------------------------*/

/*--------------------------------------------------------------------------------*/
/* imprime por pantalla la matriz A */
/* La dimension maxima para poder imprirse es 6 */
void imprimirMatrizPantalla(double **A,int dimension);
/*--------------------------------------------------------------------------------*/

/*--------------------------------------------------------------------------------*/
/* imprime a un fichero la matriz C (maximo dimension 10) */
/* requiere que el fichero haya sido abierto previamente */
void imprimirMatrizFichero(FILE *fichero,double **C,int dimension);
/*--------------------------------------------------------------------------------*/

/*--------------------------------------------------------------------------------*/
/* Analogo que imprimirMatrizPantalla pero con un vector */
void imprimirVectorPantalla(double *vector,int dimension);
/*--------------------------------------------------------------------------------*/

/*--------------------------------------------------------------------------------*/
/* Analogo que imprimirMatrizFichero pero con un vector */
void imprimirVectorFichero(FILE *fichero,double *vector,int dimension);
/*--------------------------------------------------------------------------------*/

/*--------------------------------------------------------------------------------*/
/* devuelve la matriz B de la descomposicion A=B*Bt */
/* comprueba que la matriz A sea simetrica, devolviendo
un NULL en caso de no ser simetrica */
double **descomposicionCholesky (double **A,int dimension);
/*--------------------------------------------------------------------------------*/

/*--------------------------------------------------------------------------------*/
/* lee de un fichero de texto una matriz */
/* la matriz tiene que venir de la siguiente manera */
/* en la primera linea la dimension, despues en cada linea
se van introduciendo los elementos de las distintas filas
ordenadamente. Al final y tambien en cada linea los terminos
independientes; Ejemplo:
2
1
0
0
1
1
1
Esta seria la matriz identidad de orden dos y con el vector (1,1) como
terminos independientes. */
double** leerDatos(FILE *f,int dimension);
/*--------------------------------------------------------------------------------*/

/*--------------------------------------------------------------------------------*/
/* abre un fichero que contiene una matriz con la representacion
anterior devolviendo:
la dimension si pudo abrir el fichero satisfactoriamente
0 en caso contrario */
int abrirFicheroMatriz(char *nombreFichero,FILE **fentrada);
/*--------------------------------------------------------------------------------*/

/*--------------------------------------------------------------------------------*/
/* crea un fichero con una matriz con la representacion comentada en leerDatos
para luego poder se leida por leerDatos. Como parametros requiere la matriz,
el vector de terminos independientes y la dimension de la matriz.
Devuelve:
1: pudo crear el fichero correctamente
0: no pudo crear el fichero */
int crearFicheroMatriz(double **matriz,double *vector,int dimension);
/*--------------------------------------------------------------------------------*/

/*--------------------------------------------------------------------------------*/
/* elimina el espacio reservado para una matriz */
void eliminaMatriz(double **matriz,int dimension);
/*--------------------------------------------------------------------------------*/

/*--------------------------------------------------------------------------------*/
/* Esta funcion se apoya en la funcion descomposicionCholesky para obtener la
/* matriz B y luego resolver el sistema B*z=b mediante un remonte. La solucion
/* de este sistema la utilizamos para resolver el sistema Bt*u=z mediante un
/* descenso. Requiere que la matriz sea definida positiva y simetrica */
double *resolverSistemaCholesky(double **A,double *vector,int dimension);
/*--------------------------------------------------------------------------------*/

double* resolverSistemaGauss(double **A,double *b,int dimension);

double* resolverSistemaGaussSeidel(double **A,double *b,int dimension,int *Nmax);

double *autovaloresJacobi(double **matriz,int dimension,int *Nmax);

double determinante(double **matriz,int dimension);

/*--------------------------------------------------------------------------------*/
/* Calcula la inversa de una matriz. Para ello resuelve tantos sistemas como sea
/* la dimension de entrada. La peculiaridad de estos sistemas es que tiene como
/* terminos independientes las columnas de la matriz identidad. Los vectores obtenidos
/* como soluciones de estos sistemas seran las columnas de la matriz inversa. Para
/* resolver los distintos sistemas utilizamos la funcion resolverSistemaGauss. Si
/* Gauss no es capaz de resolver el sistema devuelve NULL */
double **inversa(double **A,int dimension);
/*--------------------------------------------------------------------------------*/

/*--------------------------------------------------------------------------------*/
/* calcula el autovalor maximo de la matriz de entrada que en valor absoluto es */
/* el radio espectral de la matriz de entrada */
double potencia(double **matriz, double *x,double *autovector,int dimension,int *Nmax);
/*--------------------------------------------------------------------------------*/

/*--------------------------------------------------------------------------------*/
/* resuelve un sistema de ecuaciones por el metodo de la relajacion, que es muy
/* parecido al metodo de Gauss-Seidel pero introduciendo un parametro de
/* relajacion w. Para el calculo de este w nos apoyamos en el metodo de la
/* potencia para el calculo del autovalor maximo. Para ello es imprescindible
/* que la matriz de entrada sea tridiagonal. En caso de no ser tridiagonal
/* resolvemos el sistema con una w predefinida (ver implementacion) */
double* resolverSistemaRelajacion(double **A,double *b,int dimension,int *Nmax);
/*--------------------------------------------------------------------------------*/

double potenciaInversa(double **matriz, double *uInicial,double *autovector,int dimension,int *Nmax);

#endif

//matrices.c

#include
#include
#include
#include
#include "matrices.h"
#define TOL 0.00000001

int iguales(double **A,double **B,int dimension){
int i,j;
for(i=0;i for(j=0;j if(fabs((A[i][j])-(B[i][j])) > TOL)
return 0;
return 1;
printf("\nLas matrices estan bien");
}

int abrirFicheroMatriz(char *nombreFichero,FILE **fentrada){
int dimension;
if(*fentrada=fopen(nombreFichero,"rb"),!*fentrada){
printf("\n\n\"abrirFicheroMatriz\" informa:\n");
printf("ERROR: No se ha podido abrir el fichero \"%s\"",nombreFichero);
return 0;
}
fscanf(*fentrada,"%d\n",&dimension);
return dimension;
}

double **multiplica(double **A,double **B,int dimension){
int i,j,k;
double **C;
C=(double**)malloc(dimension*sizeof(double*));
for(i=0;i C[i]=(double*)malloc((dimension+1)*sizeof(double));
for (i=0;i for (j=0;j for (k=0;k C[i][j]=C[i][j]+A[i][k]*B[k][j];
return C;
}

double** leerDatos(FILE *f,int dimension){
double **matriz;
int i,j;

/* Asignacion de memoria dinamica*/
matriz=(double**)malloc(dimension*sizeof(double*));
for(i=0;i matriz[i]=(double*)malloc((dimension+1)*sizeof(double));

for(i=0;i for(j=0;j fscanf(f,"%lf\n",&(matriz[i][j]));

for(i=0;i fscanf(f,"%lf\n",&(matriz[i][dimension]));

fclose(f);
return matriz;
}

int tridiagonal(double **A,int dimension){
int i,j;
for(i=2;i for(j=0;j if((fabs(A[j][i])+fabs(A[i][j])) > TOL)
return 0;
return 1;
}

double *descenso(double **B,double *b,int dimension){
int i,j;
double suma,*vec;
vec=(double*)malloc(dimension*sizeof(double));
vec[0]=b[0]/(B[0][0]);
for(i=1;i suma=0.;
for(j=0;j suma+=vec[j]*B[i][j];
vec[i]=(b[i]-suma)/B[i][i];
}
return vec;
}

double *remonte(double **B,double *b,int dimension){
int i,j;
double suma,*vec;
vec=(double*)malloc(dimension*sizeof(double));
vec[dimension-1]=b[dimension-1]/(B[dimension-1][dimension-1]);
for(i=dimension-2;i>=0;i--){
suma=0.;
for(j=dimension-1;j>i;j--)
suma+=vec[j]*B[i][j];
vec[i]=(b[i]-suma)/B[i][i];
}
return vec;
}

//crout.h

#ifndef CROUT
#define CROUT

/**************METODO DE FACTORIZACION DE CROUT*****************/

void crout(double **mat,double **matriz_u,double **matriz_l,int tam);
/*procedimiento que dada una matriz y un tamaño devuelve dos matrices triangulares que su multiplicacion dan mat, dado que crout es un metodo de factorizacion*/
#endif

//crout.c

void crout(double **mat,double **mat_u,double **mat_l,int tam)
{

int i,j,k;

for (i=0; i {
for(j=0;j {
if (i==j)
mat_u[i][j]=1.;
else
mat_u[i][j]=0.;

mat_l[i][j]=0.;
}
}

mat_l[0][0]=mat[0][0];
mat_u[0][1]=(mat[0][1]/mat_l[0][0]);
mat_l[1][0]=mat[1][0];

/*Se rellenan las matrices*/

for(i=1;i {
mat_l[i][i]=mat[i][i]-(mat_l[i][i-1]*mat_u[i-1][i]);
mat_u[i][i+1]=(mat[i][i+1]/mat_l[i][i]);
mat_l[i+1][i]=mat[i+1][i];
}
mat_l[tam-1][tam-2]=mat[tam-1][tam-2];
mat_l[tam-1][tam-1]=mat[tam-1][tam-1]-mat_l[tam-1][tam-2]*mat_u[tam-2][tam-1];
}

Método de la Bisección en Lenguaje C

2008-01-24T22:48:00.000Z

#include
#include

#define Cero 0.00001

float f(float x){
return (x*x*x)-27;
}

float biseccion (float a,float b, float tol){
float c = (a+b)/2.0;

while ( (f(c) != Cero) && ( fabs(b-a) > tol ) ){
if (f(a) * f(c) < Cero)
b=c;
else
a=c;
c = (a+b)/2.0;}
return c;
}

int main(){

printf("el valor de la raiz es: %f \n", biseccion (0.0, 3.0, 0.001) );
return 0;

}

Método de Cholesky en Lenguaje C

2008-01-24T22:41:00.000Z

//Principal.c
//Autores.- Sergio Romero Sánchez & Alejandro E. Castro Robredo
//Práctica Método de Cholesky.-
//Especialidad.- I.T.I.G.
//Fecha.- 18/01/2005

#include
#include
#include "cholesky.h"
#include "Leer.h"
int main()
{
double **A,*x;
int n,i,j;

A=LeerDatos("Dto2.dat",&n);
if ( (x=Cholesky(A,n))!=NULL)
{
printf ("\nEstos son los resultados: \n");
for(i=0;i printf("\n X%d = %.14lf",i,x[i]);
free(x);
printf ("\n");
}
else
{
printf ("No se ha podido resolver el sistema \n");
}
for (i=0;i {
free(A[i]);
}
free(A);
return 1;
}

//Leer.h
double** LeerDatos(char *nombrefichero,int *dimension);

//Leer.c

#include
#include "Leer.h"
#include

double** LeerDatos(char *nombrefichero,int *dimension) {
double **matriz;
int i,j;
FILE *f;

if(f=fopen(nombrefichero,"r"),!f){
printf("Problema con la lectura del fichero\n");
return matriz;
}
fscanf(f,"%d\n",&(*dimension));

/* Asignacion de memoria dinamica*/
matriz=(double**)malloc(*dimension*sizeof(double*));
for(i=0;i<*dimension;i++)
matriz[i]=(double*)malloc((*dimension+1)*sizeof(double));

for(i=0;i<*dimension;i++)
for(j=0;j<*dimension;j++)
fscanf(f,"%lf\n",&(matriz[i][j]));

for(i=0;i<*dimension;i++)
fscanf(f,"%lf\n",&(matriz[i][*dimension]));

fclose(f);
return matriz;
}

//Cholesky.h

int Diagonalizar(double **A,double **B,int dimension);
void MatrizTraspuesta(double **A,double **At,int dimension);
void DescensoCholesky(double **B,double *y,double *b,int dimension);
void AscensoCholesky(double **Bt,double *x,double *y,int dimension);
int Simetrica (double **A,int n);
double** LeerDatos(char *nombrefichero,int *dimension);
double* Cholesky (double **A, int dimension);

//Cholesky.c

#include "cholesky.h"
#include
#include
#include

int Diagonalizar(double **A,double **B,int dimension)
/* Ambas matrices deben ya disponer de espacio de memoria dinamica
// A = matriz original de coeficientes
// B = triangular inferior (los de arriba todos a cero) despues de
aplicar Cholesky
// dimension = dimension de la matriz cuadrada*/
{
int i,j,k;
double suma,producto,z;

for(j=0;j {
for (i=j;i {
if(i==j)
{
suma = 0.;
for(k=0;k {
producto = B[j][k]*B[j][k];
suma = suma + producto;
}
if ((z=A[j][j]-suma)<=0)
{
return 0;
}
else
{
B[j][j] = sqrt(z);
}
}
else
{
suma = 0.;
for(k=0;k {
producto = B[i][k]*B[j][k];
suma = suma + producto;
}
B[i][j] = (double)(A[i][j]-suma)/B[j][j];
}
printf("\nB[%d][%d] = %.14lf",i,j,B[i][j]);
}
}
return 1;
}

void MatrizTraspuesta(double **A,double **At,int dimension)
/* Ambas matrices deben ya disponer de espacio de memoria dinamica
// A = matriz original
// At = matriz traspuesta de la matriz A
// dimension = dimension de la matriz cuadrada*/
{
int i,j;

for (j=0;j {
for(i=0;i At[i][j] = A[j][i];
}
return;
}

void DescensoCholesky(double **B,double *y,double *b,int dimension)
/*Ambas matrices deben ya disponer de espacio de memoria dinamica
// B = matriz B
// y = soluciones del descenso
// b = vector de terminos independientes
// dimension = dimension de la matriz cuadrada*/
{
int i,j;
double suma;

for(i=0;i {
suma = 0.;
for(j=0;j {
suma = suma + (B[i][j]*y[j]);
}
y[i] = (double)(b[i]-suma)/B[i][i];
}

for(i=0;i<4;i++)
printf("\ny%d = %.14lf",i,y[i]);

return;
}

void AscensoCholesky(double **Bt,double *x,double *y,int dimension)
/*Ambas matrices deben ya disponer de espacio de memoria dinamica
// Bt = matriz traspuesta de B
// x = soluciones del sistemas
// y = soluciones del descenso
// dimension = dimension de la matriz cuadrada */
{
int i,j;
double suma;

for(i=(dimension-1);i>=0;i--)
{
suma = 0.;
for(j=i;j {
suma = suma + (Bt[i][j]*x[j]);
}
x[i] = (double)(y[i]-suma)/Bt[i][i];
}
return;
}
int Simetrica (double **A,int n)

/* A=Matriz de coeficientes si es simétrica devuelve 1, en caso contrario
devuelve 0 */
{
int i,j;

for (i=0;i {
for (j=i+1;j {
if (A[i][j]!=A[j][i])
return 0;
}
}
return 1;
}

double* Cholesky (double **A, int dimension)
{
/* Matriz A contiene coefcientes y tréminos independientes
dimension de la matriz
Si A cumple condiciones de Cholesky entonces
Devuelve X con la solucion del sistema
en caso contrario
Devuelve NULL */

double *b,**B,**Bt,*x,*y;
int h,i;
if (Simetrica(A,dimension)==1)
{
b=(double*)malloc(dimension*sizeof(double));
B = (double**)malloc(dimension*sizeof(double*));
for(h=0;h B[h] = (double*)malloc(dimension*sizeof(double));

Bt = (double**)malloc(dimension*sizeof(double*));
for(h=0;h Bt[h] = (double*)malloc(dimension*sizeof(double));
x = (double*)malloc(dimension*sizeof(double));
y = (double*)malloc(dimension*sizeof(double));
for(i=0;i b[i]=A[i][dimension];

if (Diagonalizar(A,B,dimension)==1)
{
MatrizTraspuesta(B,Bt,4);
DescensoCholesky(B,y,b,dimension);
AscensoCholesky(Bt,x,y,dimension);

for (i=0;i {
free(B[i]);free(Bt[i]);
}
free(y);
free(B);
free(Bt);
free(b);
return x;
}
else
{
printf ("La matriz de coeficientes no es definida positiva,y por
tanto no se puede resolver a través de Cholesky \n");
for (i=0;i {
free(B[i]);free(Bt[i]);
}
free(y);free(B);
free(Bt);free(b);
return NULL;
}}
else
{
printf ("La matriz de coeficientes no es simétrica,y por tanto no
se puede resolver a través de Cholesky \n");
return NULL;
}}

Método de Jacobi en lenguaje C

2008-01-24T22:37:00.000Z

//----------------------------------------------------------------------------//
//Autores.- Sergio Romero Sánchez & Alejandro E. Castro Robredo
//Asignatura.- Análisis Numérico
//Práctica 4.- Implementación del Método de Jacobi
//Especialidad.- I.T.I.G.
//----------------------------------------------------------------------------//

//Librerías necesarias para la implementación//
#include
#include
#include

//Para leer los datos de un fichero//
double** LeerDatos(char *nombrefichero,int *dimension)
{double **matriz;
int i,j;
FILE *f;
if(f=fopen(nombrefichero,"r"),!f)
{
printf("Problema con la lectura del fichero\n");
return matriz;
}
fscanf(f,"%d\n",&(*dimension));

//Asignación de memoria dinamica
matriz=(double**)malloc(*dimension*sizeof(double*));
for(i=0;i<*dimension;i++)
{
matriz[i]=(double*)malloc((*dimension)*sizeof(double));
}

//Lectura de elementos de la matriz
for(i=0;i<*dimension;i++) //Recorremos las Filas
{
for(j=0;j<*dimension;j++) //Recorremos las Columnas
{
fscanf(f,"%lf\n",&(matriz[i][j])); //Almacenamos el elemento en la
} //posición ij.
}
fclose(f);
return matriz;
}

//Procedimiento que muestra una matriz
void muestra(double **matriz,int Tam)
{int i,j;
printf("\n\t");
for(i=0;i {
for(j=0;j {
printf("%lf ",matriz[i][j]);
}
printf("\n\t");
}
printf("\n");
}

//Halla el mayor elemento en valor absoluto de la triangular superior
double mayor(double **matriz,int dimension,int *p, int *q)
{int i,j;
double temp;

temp=fabs(matriz[1][0]);*p=1;*q=0;
for(i=2;i { //de la diagonal principal y por encima de esta.
for(j=0;j { //de la diagonal principal y por encima de esta.
if(fabs(matriz[i][j])>temp)
{
temp=fabs(matriz[i][j]);
*p=i;*q=j;
}
}
}
return temp; //Devolvemos en temp el valor númerico en valor absoluto más
} //alto.
//Ejemplo de lo que hace la Función Mayor, con una matriz de 3x3
//(1,2,3
// 4,5,-6 //Los elementos de la diagonal Superior serían 2,3 y -6
// 7,8,9) //Al tratarse de valor absoluto el valor que nos dará será 6.

//Procedimiento de Jacobi
double ** Jacobi(double **autoval,double **autovec,int dim,double tol,int Nmax)
{int p,q,i,j,k,n=0;
double cot,sen,tan,cos,temp,max,ip,iq;
double zero=0.0000000000000001;
//Primero inicializamos la matriz de rotacion a la identidad
for (i=0;i {
for (j=0;j<=i;j++)
{
if (i==j) autovec[i][j]=1.;
else autovec[i][j]=autovec[j][i]=0.;
}
}

max=mayor(autoval,dim,&p,&q);
while ( (ntol) )
{// Condiciones de parada
cot = (autoval[q][q] - autoval[p][p]) / (2*autoval[p][q]);
if (cot >= zero)
tan = -cot + sqrt(1 + cot * cot);
else
tan = -cot - sqrt(1 + cot *cot);

cos = 1 / sqrt(1+tan*tan);
sen = tan * cos;
for (j=0; j { //Vamos rotando la matriz original, hasta que todos
//sus elementos sean ceros,excepto la diagonal
if ((j!=p) && (j!=q))
{
temp = autoval[p][j];
autoval[p][j]=autoval[p][j]*cos - autoval[q][j] * sen;
autoval[j][p]=autoval[p][j];
autoval[q][j] = temp * sen + autoval[q][j] *cos;
autoval[j][q]=autoval[q][j];
}
}//En la diagonal tendremos los autovalores
autoval[q][q] = autoval[q][q] + tan * autoval[p][q];
autoval[p][p] = autoval[p][p] - tan * autoval[p][q];
autoval[p][q] = 0.;
autoval[q][p] = 0.;

for (i=0; i { //Vamos calculando la nueva matriz de rotación
ip=cos*autovec[i][p]+sen*autovec[i][q];
iq=-sen*autovec[i][p]+cos*autovec[i][q];
autovec[i][p]=ip; //Las columnas seran los autovectores
autovec[i][q]=iq;
}
n++;
max=mayor(autoval,dim,&p,&q);
}
//Paramos porque hemos alcanzado el nº maximo de iteraciones
if (n==Nmax) printf("Hemos superado el Número Máximo\n");
return autoval;
}

int main()
{
double **matautovalores,**matautovectores;
double tol;
int dim,Nmax,i,j;

printf("\n\n ******* METODO DE JACOBI ***********");
printf("\n\n");
printf("Vamos a calcular los autovalores y autovectores de una matriz dada");
printf("\n\n");
printf("Introduzca la tolerancia: \n");scanf("%lf",&tol);
printf("Introduzca el numero maximo de iteraciones (Nmax): \n");scanf("%i",&Nmax);
printf("\n");
matautovalores=LeerDatos("matriz10.dat",&dim);
printf("La dimension de la matriz es %d\n",dim);
printf("\n");

matautovectores=(double**)malloc(dim*sizeof(double*));

printf("La matriz de los autovectores es la primera y la de los autovalores la segunda:\n");
for(i=0;i {
matautovectores[i]=(double*)malloc(dim*sizeof(double));
}
Jacobi(matautovalores,matautovectores,dim,tol,Nmax);

muestra(matautovalores,dim);
muestra(matautovectores,dim);

printf("Los autovalores son: \n\n");
for (i=0;i {
printf(" <%lf>",matautovalores[i][i]);
}

printf("\n");
printf("\n");
printf("Los autovectores son: \n\n");
for (i=0;i {
printf("<");
for (j=0;j {
printf("<%lf>",matautovectores[j][i]);
}
printf("> \n");
}
printf("\n");
printf("\n");
printf(" ************** FIN DEL PROGRAMA ************** ");

free (matautovalores);
free(matautovectores);
return 0;
}

Método de Richardson en lenguaje C

2008-01-24T22:34:00.000Z

// Practica Final de Analisis Numerico
// Fecha: 27/01/01
// Implementar el metodo de Richardson
// que calcula los terminos independientes de multiplicar
// un vector por una matriz dada.

#include
#include
#include

void Richardson(double **matriz,int dimension,double *v, double *b)
{ // procedimiento tal cual esta en los apuntes
int i, j, k, l;
double *r, aux=0.0;
r=(double*)malloc(dimension*sizeof(double));

for (k=0; k<100; k++)
// aqui metemos un numero de iteraciones aleatorio
{
for (i=0; i {
aux = 0.0;
for (j=0; j {
aux = aux + (matriz[i][j] * v[j]);
// sumatorio del producto de la matriz
}
r[i]=b[i] - aux;
}
for (i=0; i v[i]=v[i]+r[i];
}
}
void MostrarVector(double *Vector, int Nelem)
{
int f;
for(f=0;f printf("%lf\t",Vector[f]);
}
double** LeerDatos(char *nombrefichero,int *dimension) {
double **matriz;
int i,j, veamos;
FILE *f;

if(f=fopen(nombrefichero,"r"),!f){
printf("Problema con la lectura del fichero\n");
return 0;
}
fscanf(f,"%d\n",&(*dimension));
/* Asignacion de memoria dinamica*/
matriz=(double**)malloc(*dimension*sizeof(double*));
for(i=0;i<*dimension;i++)
matriz[i]=(double*)malloc((*dimension+1)*sizeof(double));

for(i=0;i<*dimension;i++)
for(j=0;j<*dimension;j++)
fscanf(f,"%lf\n",&(matriz[i][j]));

for(i=0;i<*dimension;i++)
fscanf(f,"%lf\n",&(matriz[i][*dimension]));

fclose(f);
return matriz;
}

int main()
{
double **matriz, *v, *b;
int dimension, i, n=10;
matriz = (double**)malloc(n*sizeof(double*));
printf("******************************************************\n");
printf("************ METODO DE RICHARDSON ********************\n");
printf("******************************************************\n");
for (i=0;i matriz[i] = (double*)malloc(n*sizeof(double));
// matriz[0][0]= 1.; matriz[0][1]= .5; matriz[0][2]= .333;
// matriz[1][0]= .333; matriz[1][1]= 1.; matriz[1][2]= .5; // //matriz de ejemplo que converge
//matriz[2][0]= .5; matriz[2][1]= .333; matriz[2][2]= 1.; // resta esta //matriz y de la identidad <1
matriz=LeerDatos("matriz10.dat",&dimension);
v = (double*)malloc(n*sizeof(double));
if (v == NULL)
printf("Problemas en la asignacion de memoria");
b=(double*)malloc(n*sizeof(double));
if (b == NULL)
printf("Problemas en la asignacion de memoria");
for(i=0; i b[i]=matriz[i][dimension];
//for(i=0;i// b[i] = 0.91;
for (i=0;i v[i] = 0.0;
Richardson(matriz, n, v, b);
printf("\nEl vector solucion es:\n\n");
for(i=0;i printf("v[%d]= %lf\n\n",i,v[i]);
free(v);
free(b);
for(i=0; i free(matriz[i]);
free(matriz);
system ("PAUSE");
return;
}

Implementación de una Cola en lenguaje JAVA (Extraer, Primero, Siguiente, Concatenar, Insertar)

2008-01-23T23:41:00.000Z

El objetivo será implementar un tipo abstracto de datos que implemente una cola de espera genérica, dentro de las posibilidades del lenguaje Java, el cual, por ejemplo, en comparación con los lenguajes C++ o Ada, no dispone de estructuras sintácticas análogas al template o generic.

El diseño aquí propuesto contempla una clase principal Cola, que gestiona una cola compuesta de elementos de la clase Nodo. Los objetos de esta última clase contendrán objetos "genéricos", cuya clase el programador concretará, al usar el TAD, en función de sus necesidades. Se propone pues la siguiente implementación:

* Clase Nodo. Como se ha indicado, dispondrá de un campo (private), que será de la clase Object, lo que permitirá contener cualquier tipo de objeto (pues en Java toda clase se considera derivada de la clase Object). Contendrá asimismo un enlace protected que apunte al siguiente nodo de la cola. Desde fuera de la clase (o derivada) sólo será accesible el método dato(), que devuelve el objeto de dato que contiene. En definitiva, la clase Nodo nos servirá como tipo iterador, esto es, nos permitirá declarar objetos de esta clase en los que apoyarnos para recorrer una cola sin destruirla.
* Clase Cola. En el momento de la creación, se especificará el número máximo de elementos que puede contener la cola. Inicialmente, la cola estará vacía. Esta clase suministra los siguientes métodos:
o insertar(Object). Construye un Nodo con el objeto de dato pasado como parámetro (no se admite null), y lo inserta como nuevo último elemento de la cola.
o extraer(). Devuelve el dato asociado al primer elemento de la cola. Dicho primer elemento se extrae de la cola.
o primero(). Devuelve el primer Nodo de la cola, pero no lo extrae. La cola no se ve pues alterada.
o siguiente(Nodo). Método static que devuelve el elemento de la cola situado a continuación del elemento pasado como parámetro. Con este método podemos recorrer la cola desde primero().
o concatenar(Cola). Añade la cola pasada como parámetro a la cola sobre la que se aplica, a partir del último elemento de ésta. Si se realiza con éxito la operación, la cola pasada como parámetro quedará vacía, si no, ninguna de las dos colas se ve alterada.

Constrúyase asimismo una rutina main de prueba. Para ello puede utilizarse, por ejemplo, la clase String como clase de objetos que se almacenarán en el campo de datos dentro de Nodo. La rutina main creará, añadirá y extraerá distintos nodos a dos colas, cuyas ristras se visualizarán por pantalla, así como el resultado de su concatenación.

class Nodo extends Object{
protected Nodo Sig;
private Object Info;
public Nodo(Object E) { Sig = null ;Info = E;}
public Object dato() { return Info; }
}

class Cola extends Object {

private int Maximo; // Almacenarà el numero maximo de elementos a almacenar
private int NElementos; // Almacenarà el numero de elementos almacenados por el momento
private Nodo Primero; // Almacenarà el enlace al primer nodo a salir de la cola.

public Cola(int max) {
Maximo = max;
NElementos = 0;
Primero = null;
}
void insertar(Object E){
Nodo n;
if (Maximo > NElementos)
{
if (Primero == null) Primero = new Nodo(E);
else
{
n = Primero;
while (n.Sig != null) n = n.Sig;
n.Sig = new Nodo(E);
}
NElementos++;
}
}
Object extraer(){
Nodo n;
Object E;
if (Primero == null) E = null;
else
{
n = Primero ;
Primero = Primero.Sig;
E = n.dato() ;
n = null ;
NElementos-- ;
}
return E;
}

Nodo primero ( ){ return Primero; }
static Nodo Siguiente(Nodo n){ return n.Sig; }

void concatenar(Cola c){
if (Maximo > NElementos + c.NElementos)
{
while (c.NElementos>0){ insertar(c.extraer()); }
}
}

public static void main (String args[]) {
Cola C = new Cola(20);
Cola C2 = new Cola(8);
Nodo act = null;
Nodo act2= null;
Object Aux = null;
int fin;
String s[] = {"1ero ","2do ","3ero ","4to ","5to ","6xto ","7timo","8avo "};
System.out.println(" Prueba de inserción de 8 ristras en 2 colas (insertar )");
for (int i=0;i<8;i++){
System.out.println(" Este es el elemento numero "+i+" = '"+s[i]+"' , el cual meteré dentro de la cola") ;
C .insertar(s[i ]);
C2.insertar(s[7-i]);
}
System.out.println(" Probamos que se encuentran las 8 ristras en la colas(primero,dato,siguiente)");
fin = C.NElementos;
for (int i=0;i if (i==0){
act = C.primero();
System.out.println(" Primer elemento "+act.dato() );
act2 = C2.primero();
System.out.println(" Primer elemento(2) "+act2.dato());
}
else{
act = C.Siguiente(act);
System.out.println(" Elemento : "+act.dato());
act2 = C2.Siguiente(act2);
System.out.println(" Elemento(2) : "+act2.dato());
}
}
C.concatenar(C2);
fin = C.NElementos;
for (int i=0;i if (i==0){
act = C.primero();
System.out.println(" Primer elemento "+act.dato() );
}
else{
act = C.Siguiente(act);
System.out.println(" Elemento : "+act.dato());
}
}
fin = C.NElementos;
for (int i=0;i System.out.println(" Extrayendo Cola ["+i+"] = "+C.primero().dato());
Aux = C.extraer();
}
Aux = null;
return ;
}
}

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

2008-01-23T23:36:00.000Z

* 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

2008-01-23T23:34:00.000Z

* 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;

Cálculo de raices únicas reales en lenguaje C

2008-01-23T23:33:00.000Z

Desarrolle en TurboPascal y en C 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}

#include
#include
#include

float linf;float lsup;
float f1(float x) { return (x*x+x-12 ); }
float f2(float x) { return (x*x-3*x+2 ); }
float f3(float x) { return (x*x-2*x ); }
float f4(float x) { return ((float)(sin(x)/(11+x))); }

int Raices(float(*fx)(float),float delta,float linf,
float lsup,float *soluciones)
{

float aux,y,paso,inf,sup,medio,limite;
int nraices=0;
if (linf>lsup)
{
aux = linf;
linf = lsup;
lsup = aux;
}

y = linf;
paso = delta*100;
while (y {
if ( (fabs(fx(y))) < delta ){
nraices++;
soluciones[nraices-1]=y;
y+=paso;
}
else{
if ( ( fx(y)*fx(y+paso) ) < 0 ) {
nraices++;
inf = y;
sup = y + paso;
medio = ( y + (y+paso) )/2;
limite= medio - inf;
while ( (limite>delta) && (fx(medio)!=0) ){
if (fx(inf)*fx(medio)<0)
sup = medio;
else
inf = medio;
medio = (sup + inf)/2;
limite = medio - inf;
}
soluciones[nraices-1] = medio;
}
y+=paso;
}
}
if ( fabs(fx(lsup)) < delta ){
nraices++;
soluciones[nraices-1]=sup;
}
return nraices;
}

void main()
{
float inferior,superior,delta,Sol[10];
char opcion;
int nsol,i;

printf("comienza el programa de Raices\n");
printf("Dame el limite inferior del intervalo: ");
scanf("%f",&inferior);
printf("Dame el limite superior del intervalo: ");
scanf("%f",&superior);
printf("Dame los incrementos de subdivision del intervalo(delta): ");
scanf("%f",&delta);
do
{
printf("Opciones \n");
printf(" 1 . (x*x+x-12 ) \n");
printf(" 2 . (x*x-3*x+2) \n");
printf(" 3 . (x*x-2*x ) \n");
printf(" 4 . (sin(x)/(11+x)) \n");
printf("Dame el tipo de funcion a utilizar:\n");
opcion=getch();
}
while ((opcion>'5')||(opcion<'0'));
switch (opcion){
case '1' :
{
nsol = Raices(f1,delta,inferior,superior,Sol);
printf("Existen %d soluciones\n",nsol);
for (i=0;i printf("la %d solucion es %f\n",i+1,Sol[i]);
}
break;
}
case '2' :
{
nsol = Raices(f2,delta,inferior,superior,Sol);
printf("Existen %d soluciones\n",nsol);
for (i=0;i printf("la %d solucion es %f\n",i+1,Sol[i]);
}
break;
}
case '3' :
{
nsol = Raices(f3,delta,inferior,superior,Sol);
printf("Existen %d soluciones\n",nsol);
for (i=0;i printf("la %d solucion es %f\n",i+1,Sol[i]);
}
break;
}

case '4' :
{
nsol = Raices(f4,delta,inferior,superior,Sol);
printf("Existen %d soluciones\n",nsol);
for (i=0;i printf("la %d solucion es %f\n",i+1,Sol[i]);
}
break;
}
default : printf("Hay Problemas");
}
printf("Fin. Pulsa una tecla.....");
getch();
}

Cálculo de raices únicas reales en lenguaje TurboPascal

2008-01-23T23:31:00.000Z

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.

Programa que solicita datos personales y los muestra por pantalla en lenguaje JAVA

2008-01-23T23:27:00.003Z

* Desarrollar un programa que solicite los datos personales, en el orden que se indica, y los muestre por pantalla ( Nombre, Apellidos, Titulación y Grupo).

1. Los datos deben ser privados y estar encapsulados en una clase distinta de la principal, llamada personal. Son todos de tipo ristra excepto Grupo que es tipo entero.
2. Debe poseer un constructor que permita la inicialización de dichos datos en el momento de la creación de un objeto de esa clase.
3. En la misma clase de los datos se debe implementar un método, llamado muestra, para mostrar por pantalla todos los datos, en el mismo orden que se introdujeron.

import java.io.*;
class personal
{
private String Nombre,Apellidos,Titulación;
private int Grupo;

//CONSTRUCTOR
public personal (String n,String a,String t,int g){
Grupo=g;
Nombre=n;
Apellidos=a;
Titulación=t;
}
//MÉTODO
public void muestra(){
System.out.println("El nombre introducido es: " );
System.out.println(Nombre);
System.out.println("Los apellidos introducido son: " );
System.out.println(Apellidos);
System.out.println("Su titulacion introducido es: " );
System.out.println(Titulación);
System.out.println("Esta en el grupo: " );
System.out.println(Grupo);
}
}
public class prac03{
//PROGRAMA PRINCIPAL, SE INTRODUCEN LOS DATOS
public static void main(String args[])throws IOException{

String g,n,t,a;
InputStreamReader k = new InputStreamReader(System.in);//ENTRADA POR TECLADO LÍNEA A LÍNEA
BufferedReader q = new BufferedReader(k);
System.out.println("Por favor intrduzca el nombre: ");
n=q.readLine();
System.out.println("Por favor introduzca sus apellidos: ");
a=q.readLine();
System.out.println("Por favor introduzca su titulacion: ");
t=q.readLine();
System.out.println("Por favor introduzca su grupo: ");
g=q.readLine();
personal Alumno= new personal(n,a,t,Integer.parseInt(g));
Alumno.muestra();
}
}

Operaciones con Listas en lenguaje Prolog (Invierte, Palindroma, Sublista, Ultimo)

2008-01-23T23:27:00.001Z

Métodos de Ordenación en lenguaje Prolog

2008-01-23T23:25:00.000Z

%%%%%%%%%%%%%%%%%%% ORDENACION %%%%%%%%%%%%%%%%%%%%%%

% Ordenacion por permutacion.

ordena1(L,S):-permutacion(L,S),ordenada(S).

permutacion([],[]).
permutacion([H|T],S):-permutacion(T,T1),guarda(H,T1,S).

guarda(X,L,[X|L]).
guarda(X,[H|T],[H|S]):-guarda(X,T,S).

ordenada([]).
ordenada([_]).
ordenada([A,B|T]):-A>=B,ordenada([B|T]).

% ----------------------------------------------------

% Ordenacion por insercion.

ordena2([],[]).
ordena2([H|T],S):-ordena2(T,R),inserta(H,R,S).

inserta(X,[],[X]).
inserta(X,[H|T],[X,H|T]):-X>=H,!.
inserta(X,[H|T],[H|S]):-inserta(X,T,S).

% ----------------------------------------------------

% Ordenacion por el metodo de la burbuja.

ordena3(L1,L2):-append(U,[A,B|V],L1),Bordena3(L1,L1).

Cálculos Numéricos con Listas en Lenguaje Prolog (Primos, MCD, Combinatorios, ..)

2008-01-23T23:22:00.001Z

%%%%%%%%%%%%%% CALCULOS NUMERICOS CON LISTAS %%%%%%%%%%%%%%%%

% Lista de naturales

lnat([0]).
lnat([A,B|C]):-lnat([B|C]),A is B+1.

%-----------------------------------------------------

% Ejercicio 3.2. Lista infinita de a's.

lia([a]).
lia([a|R]):-lia(R).

%-----------------------------------------------------

% Ejercicio 3.3. Lista de negativos.

l3([-1]).
l3([A,B|C]):-l3([B|C]), A is B-1.

%-----------------------------------------------------

% Ejercicio 7.7. Lista de multiplos

lmul(N,[N]).
lmul(N,[A,B|C]):-lmul(N,[B|C]),A is B + N.

%-----------------------------------------------------

% Ejercicio 3.12. N-esimo numero triangular

e312(N,M):-lnat([H|T]), len(T,N), sumalist([H|T],M).

sumalist([],0).
sumalist([H|T],N):-sumalist(T,M),N is H + M.

% o bien

e3122(0,0):-!.
e3122(X,Y):-X1 is X-1, e3122(X1,Y1), Y is Y1+X.

%-----------------------------------------------------

% Ejercicio 7.8. Lista de fibonaccis

lfib([1]).
lfib([1,1]).
lfib([A,B,C|R]):-lfib([B,C|R]), A is B+C.

% Para obtener un numero de fibonacci hay dos metodos ineficientes.

fib(0,1).
fib(1,1).
fib(N,M):-N>1,N1 is N-1, N2 is N-2, fib(N1,M1),fib(N2,M2),M is M1 + M2.

% o bien

fib2(N,M):-lfib([M|L]),len(L,N).

% La version eficiente es

fib3(N,M):-auxfib(N,M,_).

auxfib(0,1,_).
auxfib(1,1,1).
auxfib(N,M,M1):-N1 is N-1, auxfib(N1,M1,M2), M is M1+M2.

%-----------------------------------------------------

%Ejercicio 3.4 . Lista de numeros Primos

nat(0).
nat(X):-nat(Y), X is Y +1.

nodiv(_,[]).
nodiv(N,[H|T]):-X is N mod H,X\==0,nodiv(N,T).

sigprimo([H|T],N):-nat(R),N is H + R,nodiv(N,[H|T]),!.

primos([2]).
primos([A,B|T]):-primos([B|T]),sigprimo([B|T],A).

% Factores Primos de un numero

factores(N,L):-factores(N,[2],L).

factores(N,_,[]):-(N=0;N=1;N=1.0),!.
factores(N,[H|T],[H|L]):- 0 is N mod H,!,N1 is N / H,factores(N1,[H|T],L).
factores(N,[H|T],L):-sigprimo([H|T],H1),factores(N,[H1,H|T],L).

% maximo comun divisor de dos numeros

mcd(N1,N2,N3):-factores(N1,L1),factores(N2,L2),mcd(L1,L2,N3,1).

mcd([],_,N,N).
mcd(_,[],N,N).
mcd([H|T1],[H|T2],N,M):-M1 is M*H, mcd(T1,T2,N,M1).
mcd([H1|T1],[H2|T2],N,M):-H1mcd([H1|T1],[H2|T2],N,M):-H2
%-----------------------------------------------------

% Ejercicio 2.14. Numeros combinatorios y triangulo de Pascal.

% a)

c(_,0,1):-!.
c(M,M,1):-!.
c(M,N,R):-M1 is M-1, N1 is N-1,c(M1,N,A),c(M1,N1,B),R is A+B.

% b)

tr([X],[X]).
tr([X,Y|L],[H|T]):-H is X+Y,tr([Y|L],T).

f(0,[1]):-!.
f(M,[1|L]):- M1 is M-1, f(M1,L1), tr(L1,L).

% Version mas eficiente porque no se repiten calculos

c2(M,N,R):-f(M,L), ele(N,L,R).
ele(0,[H|_],H).
ele(N,[_|T],X):- N>0,N1 is N-1, ele(N1,T,X).

Aplanar una lista (de listas) en Lenguaje Prolog

2008-01-23T23:20:00.002Z

Eliminar Elementos Repeditos de dos Listas en Lenguaje Prolog

2008-01-23T23:20:00.001Z

Eliminación de elementos repetidos.

elim([],[]).
elim([H|T],S):-member(H,T),!,elim(T,S).
elim([H|T],[H|S]):-elim(T,S).

Trenzar Dos o mas Listas en Prolog

2008-01-23T23:19:00.001Z

% Trenzar dos listas.

trenza([],L,L).
trenza([H|T],R,[H|S]):-trenza(R,T,S).

%----------------------------------------------------

% Trenzar varias listas.

trenza2([],[]).
trenza2([[]|T],R):-trenza2(T,R).
trenza2([[H|T]|R],[H|S]):-append(R,[T],U),trenza2(U,S).

Invertir Lista en Lenguaje Prolog

2008-01-23T23:18:00.000Z

Inversion de una lista

reverse([],[]).
reverse([H|T],L):-reverse(T,S),append(S,[H],L).

% o bien mas eficiente, utilizando un parametro acumulador.

rev(L1,L2):-rev(L1,L2,[]).

rev([],L,L).
rev([H|T],L,S):-rev(T,L,[H|S]).

Sustituir un Elemento por otro En lenguaje Prolog

2008-01-23T23:12:00.000Z

% Sustituir un elemento por otro.

sus(_,_,[],[]).
sus(X,Y,[X|T],[Y|S]):-!,sus(X,Y,T,S).
sus(X,Y,[Z|T],[Z|S]):-sus(X,Y,T,S).

Funciones Fibonacci y Cálculo de la Suma en Lenguaje Prolog

2008-01-23T17:28:00.000Z

/*a) Escriba un predicado suma(N,R) que sea cierto cuando R sea la suma de los naturales desde el 1 hasta N. */

suma(1,1).
suma(N,R):- not(N=0),L is N-1,K is R-N,suma(L,K).

/*b) Escriba un predicado fibo(N,R) que sea cierto cuando R sea el enésimo elemento de la serie de Fibonacci. */

fibo(1,1).
fibo(2,1).
fibo(N,R):- not(N=0),L is N-1,H is N-2,fibo(L,T),fibo(H,S),R is T+S.

Operaciones Sobre Conjuntos en Lenguaje Prolog (Miembro, Subconjunto, Disjuntos, Interseccion, Diferencia, ...)

2008-01-23T17:27:00.000Z

/* Parte a) miembro(X,L), el cual es cierto si el elemento X está en la lista L */
miembro(X,[X|_]):- !.
miembro(X,[_|Y]):- miembro(X,Y).

/*Parte b) subconjunto (L,K), el cual es válido si L es un subconjunto de K*/
subconjunto([],_).
subconjunto([A|B],K):- miembro(A,K), subconjunto(B,K).

/*Parte c) disjuntos (L,K), el cual es cierto si L y K son conjuntos disjuntos (no tienen elementos en común).*/
disjuntos([],_):- not(fail).
disjuntos([A|B],K):- not(miembro(A,K)), disjuntos(B,K).

/*Parte e) interseccion(A,B,R), el cual es válido si R es la intersección de A y B*/
interseccion([],_,[]).
interseccion([A|B],D,[A|R]):- miembro(A,D), interseccion(B,D,R).
interseccion([A|B],D,R):- not(miembro(A,D)), interseccion(B,D,R).

/*Parte d) diferencia (L,K,M), el cual es válido si M es la diferencia de L y K*/
diferencia([],_,[]).
diferencia([A|B],K,M):- miembro(A,K), diferencia(B,K,M).
diferencia([A|B],K,[A|M]):- not(miembro(A,K)), diferencia(B,K,M).

/*Ejercicio7): Defina un predicado reemplaza (L, X, Y, Z) el cuál es válido si la lista Z es igual a la lista L sustituyendo el elemento X por el elemento Y*/
reemplaza([],_,_,[]).
reemplaza([X],X,Y,[Y]).
reemplaza([A|B],A,Y,[Y|L]):- reemplaza(B,A,Y,L).
reemplaza([A|B],X,Y,[A|L]):- A\=X, reemplaza(B,X,Y,L).

/*Ejercicio8): Define un predicado borra(L, X, Z) el cual es cierto si Z es igual a la lista L tras eliminar todas las ocurrencias del elemento X*/
borra([X],X,[]).
borra([A|B],A,Z):- borra(B,A,Z).
borra([A|B],X,[A|Z]):- A\=X, borra(B,X,Z).

Longitud, Ocurrencia, Posicion y Concatenar Listas en Lenguaje Prolog

2008-01-23T17:24:00.000Z

/*Ejercicio2): Defina un predicado longitud(L,N) el cual es válido si N contiene la longitud de la lista L*/
longuitud([],0).
longuitud([_|A],N):- longuitud(A,B), N is B+1.

/*Ejercicio3): Defina un predicado ocurrencia(X,L,N) el cual es válido si el elemento X aparece N veces en la lista L*/
ocurrencia(_,[],0).
ocurrencia(X,[A|C],N):- X\=A, ocurrencia(X,C,N).
ocurrencia(X,[A|C],N):- X=A, B is N-1, ocurrencia(X,C,B).

/*Ejercicio4): Defina un predicado posicion(N,L,X) el cual es válido si X es el elemento que ocupa la posición N de la lista L*/
posicion(1,[A|_],A).
posicion(N,[_|B],A):- Aux is N-1, posicion(Aux,B,A).

/*Ejercicio5): Defina un predicado concatena(L, M, N) el cuál es válido si la lista N es la concatenación de las listas L y M*/
concatena([],L,L).
concatena([_|A],M,[_|N]):- concatena(A,M,N).

Rama Familiar en Lenguaje Prolog (Hermano, Primo, Nieto..)

2008-01-23T16:59:00.000Z

Dados un conjunto de hechos de la forma padre(nombre1,nombre2), donde nombre1 es el padre de nombre2:

* padre(antonio,juan).
* padre(antonio,carlos).
* padre(juan,diana).
* padre(juan,elena).
* padre(carlos,felipe).

Defina los siguientes predicados:

* hermano(X,Y) el cual es válido si X e Y son hermanos/as.
* primo(X,Y) el cual es válido si X e Y son primos.
* nieto(X,Y) el cual es válido si X es nieto/a de Y.
* descendiente(X,Y) el cual es verdadero si X es descendiente de Y.

/*A)hermano(X,Y) verdadero si X es hemano/a de Y. Hijos de igual madre y padre.*/
hermano(X,Y):-padre(A,X), padre(A,Y), not(X=Y).

/*B)primo(X,Y) verdadero si X es primo de Y.*/
primo(X,Y):-hermano(A,B), padre(A,X), padre(B,Y), not(X=Y).

/*C)nieto(X,Y) verdadero si X es nieto de Y.*/
nieto(X,Y):-padre(Y,A), padre(A,X), not(X=Y).

/*D)descendiente(X,Y) verdadero si X es descendiente de Y.*/
descendiente(X,Y):-padre(Y,X).
descendiente(X,Y):-nieto(Y,X).

Funcion Sublista desde dos posiciones en Lenguaje Scheme

2008-01-21T15:41:00.000Z

Defina una función sublista a la que pasándole una lista: L, y dos enteros: ini y lon, devuelva una lista formada por los elementos de L desde el ini hasta el ini+lon -1. Suponga que los elementos están numerados desde el 1 hasta n. Si se solicitan tantos elementos que se sobrepasa el final de la lista devolver el máximo posible.

(define (sublista Lista1 ini long)
(cond
((null? Lista1) null)
((= long 0) null)
((> ini 1) (sublista (cdr Lista1) (- ini 1) long))
((= ini 1)(cons (car Lista1)(sublista (cdr Lista1) ini (- long 1))))))

Fusionar Dos Listas en Una en Lenguaje Scheme

2008-01-21T15:39:00.000Z

Defina una función llamada fusiona que, pasándole dos listas de enteros ordenados, devuelva una sóla lista con todos los enteros ordenados.

(define (fusiona Lista1 Lista2)
(cond
((null? Lista1) Lista2)
((null? Lista2) Lista1)
((>= (car Lista1)(car Lista2)) (cons (car Lista2)(fusiona Lista1 (cdr Lista2))))
((<(car Lista1)(car Lista2)) (cons (car Lista1)(fusiona (cdr Lista1) Lista2)))))

Buscar un Lista en otra en Lenguaje Scheme

2008-01-21T15:38:00.000Z

Escriba una función busca que, pasándole dos listas: L1 y L2, devuelva verdadero si la lista L1 está contenida en L2, o sea, si la lista L1 es una sublista de L2 y falso en caso contrario. La sublista vacía está contenida en cualquier lista.
(define (busca Lista1 Lista2)
(cond
((null? Lista1) #t)
((null? Lista2) #f)
((eq? (car Lista1)(car Lista2))
(busca(cdr Lista1) (cdr Lista2)))
(else (busca Lista1(cdr Lista2)))))

Añadir al Final un Elemento en Lenguaje Scheme

2008-01-21T15:36:00.000Z

Defina una función snoc que, pasándole como parámetro una lista y un elemento, devuelve una lista formada por la lista pasada como primer parámetro a la que se le ha añadido como último elemento el segundo parámetro.

(define(snoc Lista1 Aux)
(if (null? Lista1)
(cons Aux null)
(cons (car Lista1) (snoc(cdr Lista1) Aux))))

Funcion Palíndroma en lenguaje Scheme

2008-01-21T15:35:00.001Z

(define (palindroma Lista)
(cond
((null? Lista) #t)
((null? (cdr Lista)) #t)
((eq? (car Lista) (rac Lista)) (palindroma (rdc (cdr Lista))))
(else #f)))

Devolver el Ultimo Elemento de un Lista en Lenguaje Scheme

2008-01-21T15:33:00.001Z

Defina una función rac que, pasándole como parámetro una lista con al menos un elemento, devuelve el último elemento de la lista.

(define (rac L)
(cond
((null? L) #f )
((not(list? L)) L )
(else (rac (cdr L)))))

Funcion Ackerman en Lenguaje Scheme

2008-01-21T15:32:00.001Z

La función de Ackermann se define como:
A(m,n) = n+1 si m=0
A(m,n) = A(m-1,1) si m > 0 y n = 0
A(m,n) = A(m-1,A(m,n-1)) en otro caso
Implemente dicha función en Scheme. No pruebe la función para valores grandes ya que crece muy deprisa.

(define (Ackermann m n)
(if(= m 0) (+ n 1)
(if(= n 0) (Ackermann (- m 1) 1)
(Ackermann (- m 1) (Ackermann m (- n 1)))
)))

Resta de dos conjuntos en Lenguaje Scheme

2008-01-21T15:26:00.000Z

Definir una función resta con dos parámetros del tipo lista l1 y l2, que devuelva una lista con el conjunto resta del primer parámetro menos el segundo. La resta del A-B se define como los elementos en A que no están en B.

(define (resta L1 L2)
(if (null? L1) null
(if (null? L2) L1
(if (esta (car L1) (interseccion L1 L2))
(resta (cdr L1) L2)
(cons (car L1) (resta (cdr L1) L2))))))

Intersección de dos Conjuntos en Lenguaje Scheme

2008-01-21T15:25:00.000Z

Definir una función interseccion con dos parámetros del tipo lista l1 y l2, que devuelva una lista con el conjunto intersección.

(define (interseccion L1 L2)
(if (null? L1) null
(if (null? L2) null
(if (esta (car L1) L2)
(cons (car L1) (interseccion (cdr L1) L2))
(interseccion (cdr L1) L2)))))

Union de dos listas en lenguaje Scheme

2008-01-21T15:24:00.001Z

Defina una función union con dos parámetros del tipo lista l1 y l2, que devuelva una lista con el conjunto unión.

(define (union L1 L2)
(if(null? L1)
L2
(if (esta (car L1) L2) (union (cdr L1) L2)
(cons (car L1) (union (cdr L1) L2)))))

Elementos repetidos en un lista en Lenguaje Scheme

2008-01-21T15:22:00.000Z

Defina una función esconjunto con un parámetro del tipo lista l que devuelva falso si la lista tiene elementos repetidos y verdadero en otro caso.

(define (esconjunto L)
(if(null? L)#t
(if(esta (car L) (cdr L) )#f
(esconjunto (cdr L))
)))

Función Fibonacci en Lenguaje Scheme

2008-01-21T15:20:00.000Z

Defina una función fibo que acepte un entero n como parámetro y que devuelva el elemento ;enésimo de la serie de Fibonacci.

(define (fibo n)
(if(<= n 1) 1
(+ (fibo(- n 1)) (fibo(- n 2)))
)
)

Extrae desde dos posiciones en Lenguaje Scheme

2008-01-21T15:19:00.000Z

Escriba una función extrae la cuál debe constar de tres argumentos: una lista, un número de posición inicial y otro número de posición final. La función deberá devolver la lista formada sólo por las letras comprendidas entre la posición inicio y final. En el caso que la lista esté vacía o bien inicio sea mayor que final se devolverá la lista vacía. Si final sobrepasa el tamaño de la lista se devolverán todos los elementos posibles

(define (extrae Lista1 inicio final)
(if (zero? final) null
(if (zero? inicio) null
(if (null? Lista1) Lista1
(if(= inicio 1) (cons (car Lista1) (extrae (cdr Lista1) 1 (- final 1)))
(extrae (cdr Lista1) (- inicio 1) (- final 1)))))))

Número de veces que aparece un valor en un lista en Lenguaje Scheme

2008-01-21T15:18:00.001Z

Defina en Scheme una función ocurrencia que permita contar el número de veces que aparece un determinado valor dentro de una lista. Utilice para ello la función let

(define (ocurrencia x Lista1)
(if(null? Lista1) 0
(if(eq? x (car Lista1)) (+ 1 (ocurrencia x (cdr Lista1)))
(ocurrencia x (cdr Lista1)))))

Elimina elementos repetidos de una lista en Lenguaje Scheme

2008-01-21T15:16:00.000Z

Escriba una función repetidos que recibe como único argumento una lista y retorna otra lista a la que se ha eliminado los elementos repetidos de la lista de entrada (dejando únicamente la última aparición). Puede utilizar para ello la función miembro? (en otro post)

(define (repetidos Lista1)
(cond
((null? Lista1) Lista1)
((miembro? (car Lista1) (cdr Lista1)) (repetidos (cdr Lista1)))
(else (concatena (list (car Lista1)) (repetidos (cdr Lista1))))))

Ver si un Elemento esta en la Lista en lenguaje Scheme

2008-01-21T15:15:00.000Z

Escriba una función miembro? que permita verificar (verdadero o falso) si x es un elemento que está en la lista ls usando equal? para comparar (no puede usar el procedimiento member de scheme)

(define (miembro? x Lista1)
(if (null? Lista1)
#f
(if (eq? x (car Lista1))
#t
(miembro? x (cdr Lista1)))))

Elimina apariciones de un elemento en un lista en Lenguaje Scheme

2008-01-21T15:14:00.000Z

Utilizando la función equal?, defina una función elimina que dado un elemento y una lista, devuelva dicha lista en la cual se han eliminado todas las apariciones del elemento

(define (elimina x Lista1)
(if (null? Lista1)
'()
(if (eq? x (car Lista1))
(elimina x (cdr Lista1))
(cons (car Lista1) (elimina x (cdr Lista1))))))

Invierte Lista en lenguaje Scheme

2008-01-21T15:12:00.000Z

Utilizando la función concatena (esta en otro post), defina una función invierte que dada una lista devuelva dicha lista con sus elementos en orden inverso.

(define (invierte Lista1)
(cond
((null? Lista1) '())
((list? Lista1) (concatena (invierte(cdr Lista1))(list(car Lista1))))
(else (display '(Debe pasar una lista como parametro)))))