practica 11 ejercicio 2, Pascal

Language: Layout:

program HelloWorld;
{-----------------------------------------------------------------------------------------------------------------------}
{-----------------------------------------------------------------
CONST - Define las constantes para usar en tiempo de compilacion}
const
    categorias = 4;
    caracteres = 70;
    FIN = 'fin';
{-----------------------------------------------------------------------------------------------------------------------}

{-----------------------------------------------------------------------------------------------------------------------}
{-----------------------------------------------------------------
TYPE - Define los tipos creados por el usuario para usar en tiempo 
de compilacion}
type
    conj = set of char;
    
    rangoCategorias = 1 .. categorias;
    rangoCaracteres = 1 .. caracteres;
    
    Tnombre = string[15];
    
    Tvector = record
        vector : array [rangoCaracteres] of char;
        DimL : rangoCaracteres;
    end;
    
    Tcliente = record
        nombre : Tnombre;
        apellido : Tnombre;
        categoria : rangoCategorias;
        montoBasico : real;
        direccion : Tvector;
    end;
    
    Tlista = ^nodo;
    nodo = record 
        datos : Tcliente;
        sig : Tlista;
    end;
    
    montoExtra = array [rangoCategorias] of real;
{-----------------------------------------------------------------------------------------------------------------------}

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

{
    
    Tcliente = record
        nombre : Tnombre;
        apellido : Tnombre;
        categoria : rangoCategorias;
        montoBasico : real;
        direccion : Tvector;
    end;
    
}

// imprimir lista

{-----------------------------------------------------------------------------------------------------------------------}
{-----------------------------------------------------------------
IMPRIMIR ELEMENTO ...}
procedure imprimirElemento(e  : Tcliente);
var i : rangoCaracteres;
begin
    writeln('nombre : ',e.nombre);
    writeln('apellido : ',e.apellido);
    writeln('categoria : ',e.categoria);
    writeln('monto basico : ',e.montoBasico:10:2);
    write('direccion :  ');
    for i := 1 to e.direccion.DimL do write(e.direccion.vector[i]);
    writeln;
    writeln('-----------------------------------------------------------------');
end;

{-----------------------------------------------------------------
IMPRIMIR LISTA ...}
procedure imprimirLista( l: Tlista);
begin
    writeln('imprimimos lista -----------------------------------------------------------------');
    while l <> nil do begin
        imprimirElemento(l^.datos);
        l:= l^.sig;
    end;
    writeln('---------------------------------------------------------------------------------------------------------------');
end;
{-----------------------------------------------------------------------------------------------------------------------}

{
    
    Tcliente = record
        nombre : Tnombre;
        apellido : Tnombre;
        categoria : rangoCategorias;
        montoBasico : real;
        direccion : Tvector;
    end;
    
}

// cargar listas
{-----------------------------------------------------------------------------------------------------------------------}
{-----------------------------------------------------------------
LEER DIRECCION ...}
procedure leerDireccion (var v : Tvector);
var car : char;
begin
    v.DimL := 1;
    read(car);    
    while (car <> '.') and (v.DimL < caracteres) do begin
        v.vector[v.DimL] := car;
        v.DimL := v.DimL + 1;        
        read(car);        
    end;
    readln;
    if v.DimL > 1 then
        v.DimL := v.DimL - 1;
end;//

{-----------------------------------------------------------------
LEER ELEMENTO ...}
procedure leerElemento(var e : Tcliente);
begin
    readln(e.nombre);
    if e.nombre <> FIN then begin
        readln(e.apellido);
        e.montoBasico :=random(10000);
        e.categoria:=random(categorias)+1;
        leerDireccion(e.direccion);
    end;    
end;
{-----------------------------------------------------------------
AGREGAR ELEMENTO ...}
procedure agregarElemento(var l : Tlista; e : Tcliente);
var nue : Tlista;
begin
    new(nue);
    nue^.datos:= e;
    nue^.sig := l;
    l:= nue;
end;
{-----------------------------------------------------------------
CARGAR LISTA ...}
procedure cargarLista(var l: Tlista);
var e : Tcliente;
begin
    l := nil;
    leerElemento(e);
    while e.nombre <> FIN do begin
        agregarElemento(l,e);
        leerElemento(e);
    end;
end;
{-----------------------------------------------------------------------------------------------------------------------}

// cargar vector
{-----------------------------------------------------------------------------------------------------------------------}
{-----------------------------------------------------------------
CARGAR VECTOR ...}
procedure cargarVector(var v : montoExtra);
var
    i : rangoCategorias;
begin
    for i := 1 to categorias do v[i] := random(2600);
end;
{-----------------------------------------------------------------------------------------------------------------------}

// imprimir vector
{-----------------------------------------------------------------------------------------------------------------------}
{-----------------------------------------------------------------
IMPRIMIR VECTOR...}
procedure imprimirVector(v: montoExtra);
var i : rangoCategorias;
begin
    for i := 1 to categorias do
        write('-------');
    for i := 1 to categorias do
        write(' | ',v[i]:4:2);
    writeln(' | ',v[i]:4:2,' | ');
    for i := 1 to categorias do
        write('-------');
end;
{-----------------------------------------------------------------------------------------------------------------------}

{-----------------------------------------------------------------------------------------------------------------------}
procedure espacio;
begin
    writeln;writeln;writeln;writeln;
    writeln('-----------------------------------------------------------------------------------------------------------------------');
    writeln;writeln;writeln;writeln;
end;

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

{-----------------------------------------------------------------------------------------------------------------------}
{-----------------------------------------------------------------
}
function pasarMinus (car :  char): char;
begin
    case car of
        'A': pasarMinus:= 'a';
        'B': pasarMinus:= 'b';
        'C': pasarMinus:= 'c';
        'D': pasarMinus:= 'd';
        'E': pasarMinus:= 'e';
        'F': pasarMinus:= 'f';
        'G': pasarMinus:= 'g';
    end;
end;
{-----------------------------------------------------------------
}
procedure inicializarConjunto(var c1 : conj; var digitoPar : conj; var A : Tvector; var exito : boolean; var j : rangoCaracteres; var A2 : conj; var i : rangoCaracteres);
begin
    c1 := ['A','B','C','D','E','F','G'];
    digitoPar := ['2','4','6','8'];
    exito := true;
    A.DimL := 1;
    j := 1; i := 1;
    A2:= [];
    
end;
{-----------------------------------------------------------------
}
procedure parteA(var v : Tvector; var i : rangoCaracteres; var exito  : boolean; var A : Tvector;c1,digitoPar:conj ;var A2 : conj );
begin
        while(v.vector[i] <> '%') and (exito) do begin
            if not (v.vector[i] in c1)or not(v.vector[i] in digitoPar) then begin  exito := false;    
                                         end else begin  
                                             if v.vector[i] in c1 then begin  
                                                     A.vector[A.DimL] := pasarMinus(v.vector[i]); 
                                                     A.DimL := A.DimL + 1;
                                             end;
                                             A2 := A2 + [v.vector[i]];
                                             i := i+1;
                                         end;
         end;
                                         A.DimL := A.DimL - 1;     
end;
{-----------------------------------------------------------------
}
procedure parteB(var v : Tvector; var i : rangoCaracteres; var exito : boolean; var j : rangoCaracteres;A : Tvector);
begin
    
        // se verifica b :
        while(v.vector[i] <> '%') and (exito)  do begin
            if not (v.vector[i] <> A.vector[j]) then begin    exito := false;    
                                         end else begin    
                                                         i := i+1;
                                                         j := j+1;
                                                  end;
      end;
end;
{-----------------------------------------------------------------
}
procedure parteC(var v : Tvector; var i : rangoCaracteres; var exito : boolean; A2 : conj);
begin
    while (v.vector[i] <> '%') and (exito)and (i < v.DimL)do begin
            if (v.vector[i] in A2) then begin    exito := false;    
                                         end else i := i+1;
        end;

end;
{-----------------------------------------------------------------
}
function cumple(v : Tvector):boolean;
var
    i : rangoCaracteres;
    c1,digitoPar : conj;
    exito : boolean;
    A : Tvector;A2 : conj;
    j : rangoCaracteres;
begin
    inicializarConjunto(c1,digitoPar,A,exito,j,A2,i);
    while (exito) and (i <= v.DimL)do begin
        // se verifica a :
        parteA(v ,i ,exito,A,c1,digitoPar,A2);
        // pasamos '%'
        i := i+1;
        parteB(v,i,exito,j,A);
        i := i+1;
        // se verifica c : 
        parteC(v,i,exito,A2);
    end;
    cumple := exito;
end;
{-----------------------------------------------------------------
}
procedure informar(r : montoExtra;nmax : Tnombre);
var i : rangoCategorias;
begin
    for i := 1 to categorias do
        writeln('para la categoria ',i, ' se recaudó ',r[i]:10:2);
    
    if r[2] = 0 then begin writeln(' no se recaudo en la categoria 2');
    end else writeln(' el nombre de la persona que mas pago en la categoria 2 fue ',nmax);
end;
{-----------------------------------------------------------------
}
procedure masPago(l : Tlista;var max : real; var nmax : Tnombre);
begin
        if l^.datos.categoria = 2 then begin
                if  l^.datos.montoBasico > max then begin
                    max := l^.datos.montoBasico;
                    nmax := l^.datos.nombre;
                end;
        end;
end;

{-----------------------------------------------------------------
}
procedure inicializacion(var r : montoExtra; var max : real);
var i : rangoCategorias;
begin
    for i := 1 to categorias do
        r[i] := 0;
    max := 0;
end;
{-----------------------------------------------------------------
}
procedure recorrerLista(l : Tlista; v : montoExtra);
var 
    r : montoExtra; // se utilizara para calcular el monto total facturado por la empresa para cadacategoria
    max : real;
    nmax : Tnombre;
begin
    inicializacion(r,max);
    while l <> nil do begin
        // ejercicio 1:
        r[l^.datos.categoria] := r[l^.datos.categoria] + l^.datos.montoBasico + v[l^.datos.categoria];
        // ejercicio 2:
        masPago(l,max,nmax);
        // ejercicio 3:
        writeln('la secuencia cumple : ',cumple(l^.datos.direccion));
        
        l := l^.sig;
    end;
    
    informar(r,nmax);

end;
{-----------------------------------------------------------------------------------------------------------------------}

{-----------------------------------------------------------------------------------------------------------------------}
{-----------------------------------------------------------------
PROGRAMA PRINCIPAL}
var
    l : Tlista;
    v : montoExtra;
begin
    cargarLista(l);
    imprimirLista(l);espacio;
    
    
    cargarVector(v);
    imprimirVector(v);espacio;
    recorrerLista(l,v);
    
    
end.
{-----------------------------------------------------------------------------------------------------------------------}

​x
procedure inicializarConjunto(var c1 : conj; var digitoPar : conj; var A : Tvector; var exito : boolean; var j : rangoCaracteres; var A2 : conj; var i : rangoCaracteres);
 
program HelloWorld;
{-----------------------------------------------------------------------------------------------------------------------}
{-----------------------------------------------------------------
CONST - Define las constantes para usar en tiempo de compilacion}
const
    categorias = 4;
    caracteres = 70;
    FIN = 'fin';
{-----------------------------------------------------------------------------------------------------------------------}
​
​
​
​
{-----------------------------------------------------------------------------------------------------------------------}
{-----------------------------------------------------------------
TYPE - Define los tipos creados por el usuario para usar en tiempo 
de compilacion}
type
    conj = set of char;
    
    rangoCategorias = 1 .. categorias;
    rangoCaracteres = 1 .. caracteres;
    
    Tnombre = string[15];
    
    Tvector = record
        vector : array [rangoCaracteres] of char;
        DimL : rangoCaracteres;
    end;
    
    Tcliente = record
        nombre : Tnombre;
        apellido : Tnombre;
        categoria : rangoCategorias;
        montoBasico : real;
        direccion : Tvector;
    end;

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