practica 9 ejercicio 9 BETA, Pascal

Language: Layout:

program HelloWorld;
{-----------------------------------------------------------------------------------------------------------------------}
{-----------------------------------------------------------------
CONST - Define las constantes para usar en tiempo de compilacion}
const
    categorias = 4;
    codigos = 30;
    FIN = 'fin';
    maximos = 5;
{-----------------------------------------------------------------------------------------------------------------------}

{-----------------------------------------------------------------------------------------------------------------------}
{-----------------------------------------------------------------
TYPE - Define los tipos creados por el usuario para usar en tiempo 
de compilacion}
type
    rangoMaximos = 1 .. maximos;
    rangoCategorias = 1 .. categorias;
    rangoCodigos = 1 .. codigos;
    Tnombre = string[14];
    Telemento = record
        nombre : Tnombre;
        codigo : rangoCodigos;
        categoria : rangoCategorias;
        asiento : integer;
    end;
    
    Tlista = ^nodo;
    nodo = record
        datos : Telemento;
        sig : Tlista;
    end;
    
    Tmatriz = array [rangoCategorias,rangoCodigos] of real;
    
    
    Telemento2 = record
        monto : real;
        veces : integer;
        codigo : rangoCodigos;
    end;
    
    Tlista2  = ^nodo2;
    nodo2 = record
        datos: Telemento2;
        sig : Tlista2;
    end;
    
    Telemento3 = record
        veces : integer;
        codigo : rangoCodigos;
    end;
    
    Tvector = array [rangoMaximos] of Telemento3;
{-----------------------------------------------------------------------------------------------------------------------}

{-----------------------------------------------------------------------------------------------------------------------}
{-----------------------------------------------------------------
VARIABLES GLOBALES - Define variables que se podran usar por todos los modulos
de ser necesarias}
//var
{-----------------------------------------------------------------------------------------------------------------------}

{-----------------------------------------------------------------------------------------------------------------------}
{-----------------------------------------------------------------
AGREGAR ORDENADO }
procedure agregarOrdenado(var l : Tlista; e : Telemento);
var
    ant,nue,act : Tlista;
begin
    new(nue);
    nue^.datos := e;
    act := l;
    while (act <> nil)and(act^.datos.codigo < nue^.datos.codigo) do begin
        ant := act;
        act := act^.sig;
    end;
    if act = l then begin l := nue;
                end else ant^.sig := nue;
    nue^.sig := act;
end;
{-----------------------------------------------------------------
LEER ELEMENTO }
procedure leerElemento(var e : Telemento);
begin
    readln(e.nombre);
    if e.nombre <> FIN then begin
        e.codigo := random(codigos)+1;
        e.categoria := random(categorias)+1;
        e.asiento := random(1000)+1;
    end;
end;

{-----------------------------------------------------------------
CARGAR LISTA }
procedure cargarLista(var l : Tlista);
var
    e  : Telemento;
begin
    l := nil;
    leerElemento(e);
    while e.nombre <> FIN do begin
        agregarOrdenado(l,e);
        leerElemento(e);
    end;
end;
{-----------------------------------------------------------------------------------------------------------------------}

{-----------------------------------------------------------------------------------------------------------------------}
{-----------------------------------------------------------------
IMPRIMIR ELEMENTO}
procedure imprimirElemento(e : Telemento);
begin
    writeln('-----------------------');
    writeln('nombre: ',e.nombre);
    writeln('codigo: ',e.codigo);
    writeln('asiento: ',e.asiento);
    writeln('categoria: ',e.categoria);    
end;
{-----------------------------------------------------------------
IMPRIMIR LISTA }
procedure imprimirLista(l : Tlista);
begin
    while l <> nil do begin
        imprimirElemento(l^.datos);
        l:= l^.sig;
    end;
    writeln('-----------------------------------------------------------------');
end;
{-----------------------------------------------------------------------------------------------------------------------}

{-----------------------------------------------------------------------------------------------------------------------}
{-----------------------------------------------------------------
IMPRIMIR ELEMENTO 2}
procedure imprimirElemento2(e : Telemento2);
begin
    writeln('-----------------------');
    writeln('monto: ',e.monto:5:2);
    writeln('codigo: ',e.codigo);
    writeln('veces: ',e.veces);    
end;
{-----------------------------------------------------------------
IMPRIMIR LISTA 2}
procedure imprimirLista2(l : Tlista2);
begin
    while l <> nil do begin
        imprimirElemento2(l^.datos);
        l:= l^.sig;
    end;
    writeln('-----------------------------------------------------------------');
end;
{-----------------------------------------------------------------------------------------------------------------------}

{-----------------------------------------------------------------------------------------------------------------------}

{-----------------------------------------------------------------
CARGAR MATRIZ }
procedure cargarMatriz(var m  : Tmatriz);
var
    i : rangoCategorias;
    j : rangoCodigos;
begin
    for i := 1 to categorias do begin
        for j := 1 to codigos do begin
            m[i,j] := random(1000)+(100*i);
        end;
    end;
end;
{-----------------------------------------------------------------
IMPRIMIR MATRIZ }
procedure imprimirMatriz(m : Tmatriz);
var
    i : rangoCategorias;
    j : rangoCodigos;
begin
    for j := 1 to codigos do begin
        writeln(' -----------------------------');
        for  i := 1 to categorias-1 do
            write(' | ',m[i,j]:4:0);
        writeln(' | ',m[categorias,j]:4:0,' |');
    end;
    writeln(' -----------------------------');
end;
{-----------------------------------------------------------------------------------------------------------------------}

{-----------------------------------------------------------------------------------------------------------------------}
{-----------------------------------------------------------------
LIBERAR LISTA }
procedure liberarLista(var l : Tlista);
var aux : Tlista;
begin
    while l <> nil do begin
        aux := l^.sig;
        dispose (l);
        l:=aux;
    end;
end;
{-----------------------------------------------------------------
LIBERAR LISTA 2}
procedure liberarLista2(var l : Tlista2);
var aux : Tlista2;
begin
    while l <> nil do begin
        aux := l^.sig;
        dispose (l);
        l:=aux;
    end;
end;
{-----------------------------------------------------------------------------------------------------------------------}

{-----------------------------------------------------------------------------------------------------------------------}
{-----------------------------------------------------------------
AGREGAR ORDENADO }
procedure agregarOrdenado(var l3 : Tlista2; e : Telemento2);
var 
    ant,act,nue : Tlista2;
begin
    new(nue);
    nue^.datos := e;
    act := l3;
    while (act <> nil)and(act^.datos.monto < nue^.datos.monto) do begin
                                                                        ant := act;
                                                                        act := act^.sig;
                                                                  end;
    if act = l3 then begin l3 := nue;
                 end else ant^.sig := act^.sig;
    nue^.sig := act;
end;

{-----------------------------------------------------------------
LEER ELEMENTO PARA LA LISTA 2}
procedure leerElemento2(var e2 : Telemento2; e : Telemento; m  : Tmatriz );
begin
    e2.veces := e2.veces + 1;
    e2.monto := e2.monto + m[e.codigo,e.categoria];
end;

{-----------------------------------------------------------------
AGREGAR ELEMENTO EN LA LISTA 2}
procedure agregarElemento2(var l2 : Tlista2; e2 : Telemento2);
var
    nue : Tlista2;
begin
    new(nue);
    nue^.datos := e2;
    nue^.sig := l2;
    l2 := nue;
end;

{-----------------------------------------------------------------
INICIALIZACION}
procedure inicializacion2(var e2 : Telemento2; cod : rangoCodigos);
begin
    e2.codigo := cod;
    e2.veces := 0;
    e2.monto := 0;
end;

{-----------------------------------------------------------------
COMPARAR ...}
procedure comparar(var v :Tvector; e : Telemento2);
var
    exito : boolean;
    n : rangoMaximos;
    i : integer;
begin
    i := 1;
    exito := false;
    repeat
        if v[i].veces < e.veces then begin
            for n := maximos downto i do 
                v[n] := v[n-1];
            v[i].veces := e.veces;
            v[i].codigo := e.codigo;
            exito := true;
        end;
        i := i + 1;
    until((exito)or(i > maximos));

end;
{-----------------------------------------------------------------
RECORRER CODIGO ...}
procedure recorrerCodigo(var l : Tlista ; cod : rangoCodigos; m : Tmatriz; var l2 : Tlista2; var v : Tvector;var l3: Tlista2);
var 
    e2 : Telemento2;
begin

// ejercicio 1,2,,,
    inicializacion2(e2,cod);
        
    while (l^.datos.codigo = cod )and(l <> nil)do begin
        
        // prueba ,,,,        
        imprimirElemento(l^.datos);
        
        // ejercicio 1,,,,
        leerElemento2(e2,l^.datos,m);
        
        // pasar al siguiente elemento ,,,,
        l := l^.sig;
    end;
    
    // ejercicio 2,,,,
    comparar(v,e2);
    
    // ejercicio 1,,,,
    agregarElemento2(l2,e2);
    
    // ejercicio 3,,,,
    if e2.veces > 46 then agregarOrdenado(l3,e2);

end;
{-----------------------------------------------------------------
INICIALIZACION 1 ...}
procedure inicializacion1(var l2 : Tlista2;var l3: Tlista2;var v :Tvector);
var
    i : rangoMaximos;
begin
    l2 := nil;
    l3 := nil;
    for i := 1 to maximos do  v[i].veces:=0;
end;

{-----------------------------------------------------------------
IMPRIMIR VECTOR ...}
procedure imprimirVector(v: Tvector);
var
    i : rangoMaximos;
begin
    for i := 1 to maximos do begin
        writeln('veces: ',v[i].veces);
        writeln('codigo: ',v[i].codigo);
        writeln('-----------------------');
    end;
end;
{-----------------------------------------------------------------
RECORRER LISTA ....}

procedure recorrerLista(l : Tlista; m : Tmatriz);
var
        l2 , l3: Tlista2;
        cod : rangoCodigos;
        v : Tvector;
begin    
    inicializacion1(l2,l3,v);
    
    while l <> nil do begin
       recorrerCodigo(l,l^.datos.codigo,m,l2,v,l3);
    
        l := l^.sig;
    end;
    
    imprimirVector(v);
    
    writeln('//////////////////////////////////////////////////////lista 2/////////////////////////////////////////////////////////////');
    imprimirLista2(l2);
    writeln('//////////////////////////////////////////////////////lista 3/////////////////////////////////////////////////////////////');
    imprimirLista2(l3);
    liberarLista2(l2);
    liberarLista2(l3);
end;

{-----------------------------------------------------------------------------------------------------------------------}

{
9. * Se cuenta con una lista que contiene información de las ventas realizadas
por una empresa de venta de pasajes aéreos. Cada venta está compuesta por un nombre de persona,
código de vuelo, categoría de pasaje y número de asiento. La lista puede contener 0, 1 o más registros
por cada código de vuelo, y está ordenada por este campo.
El costo de un pasaje depende del vuelo y de su categoría.
Se dispone de una estructura eficiente que por cada combinación de vuelo 
(son 30) y categoría (4 por vuelo) se almacena su precio.

a) Generar una lista de registros que contenga por cada código de vuelo, 
el total de pasajes vendidos y el monto total recaudado.
b) Calcular e informar los códigos de los 5 vuelos más vendidos.
c) Generar una lista de los códigos de vuelos cuya cantidad de pasajes vendidos sea mayor que 46. 
La lista debe ir generándose ordenada por monto total a medida que se realiza el proceso a).
}

{-----------------------------------------------------------------------------------------------------------------------}
{-----------------------------------------------------------------
PROGRAMA PRINCIPAL}
var
    l : Tlista;
    m : Tmatriz;
begin
    randomize;
    
    cargarLista(l);
    
    cargarMatriz(m);
    
    imprimirLista(l);
    
    imprimirMatriz(m);
    
    recorrerLista(l,m);
    
    liberarLista(l);
      
end.
{-----------------------------------------------------------------------------------------------------------------------}

Show compiler warnings [ - ] Show input
Compilation time: 0.25 sec, absolute running time: 0.18 sec, cpu time: 0.01 sec, memory peak: 5 Mb, absolute service time: 0,66 sec