practica 7 ejercicio 10, Pascal

Language: Layout:

program HelloWorld;
{-----------------------------------------------------------------------------------------------------------------------}
{-----------------------------------------------------------------
CONST - Define las constantes para usar en tiempo de compilacion}
const
     DimF  =  2000;
     FIN   =  'fin';
{-----------------------------------------------------------------------------------------------------------------------}

{-----------------------------------------------------------------------------------------------------------------------}
{-----------------------------------------------------------------
TYPE - Define los tipos creados por el usuario para usar en tiempo 
de compilacion}
type
    Tnombre = string [15];
    rangoNombres = 0 .. DimF;
    Tvector = record
        vector : array [rangoNombres] of Tnombre;
        DimL : rangoNombres;
    end;
{-----------------------------------------------------------------------------------------------------------------------}

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

{-----------------------------------------------------------------------------------------------------------------------}
{-----------------------------------------------------------------
BUSCAR NOMBRE}
function buscarNombre(v:Tvector;n:Tnombre;pri,ult:rangoNombres):rangoNombres;
var mid : rangoNombres;
begin
    mid := (pri + ult) div 2;
    if (v.vector[pri] > n ) or (v.vector[ult] < n) or ((v.vector[mid]>n)and(v.vector[mid-1] < n))or((v.vector[mid+1] > n)and(v.vector[mid] < n)) then begin
        buscarNombre := 0;
    end else
        if (v.vector[mid] > n) then begin
            buscarNombre:= buscarNombre(v,n,pri,mid-1);
        end else
            if (v.vector[mid]< n) then begin
                buscarNombre:= buscarNombre(v,n,mid+1,ult);
            end else
                buscarNombre:= mid;
end;
{-----------------------------------------------------------------
INSERTAR ORDENADO}
procedure insertarOrdenado(var v :Tvector; n : Tnombre; var exito:boolean);
var
    j,i : rangoNombres;
begin
    if v.DimL < DimF then begin
                if (v.vector[v.DimL] < n )or(v.DimL = 0) then begin  //FINAL - VACIO
                    v.vector[v.DimL+1]:= n;
                end else                                            // MEDIO - PRINCIPIO
                    begin
                        i := 1;
                        while (v.vector[i] < n) and (i < v.DimL)do i:= i+1;
                        for j := v.DimL+1 downto i do v.vector[j]:=v.vector[j-1];
                        v.vector[i]:= n;   
                    end;
        v.DimL := v.DimL + 1;
        exito:=true;
    end else
        begin
            writeln('el vector está lleno no se pueden ingresar mas nombres');
            exito:=false;
        end;
end;
{-----------------------------------------------------------------
CARGAR VECTOR}
procedure cargarVector(var v : Tvector);
var
    n :Tnombre;
    validar:boolean;
begin
    readln(n);
    v.DimL := 0;
    validar:= (v.DimL < DimF);
    while (n <> FIN) and (validar ) do begin
        insertarOrdenado(v,n,validar);
        readln(n);
    end;
end;
{-----------------------------------------------------------------
IMPRIMIR VECTOR }
procedure imprimirVector(v : Tvector);
var j : rangoNombres;
begin
    for j := 1 to v.DimL do 
        write('-------');
    writeln;
    for j := 1 to v.DimL-1 do 
        write(' | ', v.vector[j]);
    writeln(' | ',v.vector[v.DimL],' |');
    for j := 1 to v.DimL do 
        write('-------');
    writeln;
    
end;
{-----------------------------------------------------------------
INFORMAR POSICION }
procedure informarPosicion(v : Tvector);
var
    n:Tnombre;
    c:rangoNombres;
begin
    readln(n);
    c:= buscarNombre(v,n,1,v.DimL);
    if c <> 0 then begin
        writeln('el nombre buscado se encuentra en la posicion ',c);
    end else
        writeln('el nombre buscando no se encuentra cargado');
end;
{-----------------------------------------------------------------
INFORMAR INSERT }
procedure informarInsert(var v:Tvector);
var
    n:Tnombre;
    exito:boolean;
begin
    readln(n);
    exito:=true;
    insertarOrdenado(v,n,exito);
    if exito then begin
        writeln('el nombre se ha insertado con exito');
        imprimirVector(v);
    end;
end;
{-----------------------------------------------------------------
ELIMINAR POSICION }
procedure eliminarPosicion(var v:Tvector;p:rangoNombres);
var
    i:rangoNombres;
begin
    for i:= p to v.DimL-1 do v.vector[i] := v.vector[i+1];
    v.DimL := v.DimL - 1;
end;

{-----------------------------------------------------------------
ELIMINAR NOMBRE }
procedure eliminarNombre(var v:Tvector);
var
    h:rangoNombres;
    n:Tnombre;
begin
    readln(n);
    repeat
        h:=buscarNombre(v,n,1,v.DimL);
        if h <> 0 then
            eliminarPosicion(v,h);
    until(h = 0);  
    imprimirVector(v);
end;

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

{-----------------------------------------------------------------------------------------------------------------------}
{-----------------------------------------------------------------
PROGRAMA PRINCIPAL}
var
    v : Tvector;
    
    
begin
    cargarVector(v);
    imprimirVector(v);
    //ejercicio a
    informarPosicion(v);
    //ejercicio b
    informarInsert(v);
    //ejercicio c y d
    eliminarNombre(v);
end.
{-----------------------------------------------------------------------------------------------------------------------}

Show compiler warnings [ - ] Show input
Compilation time: 0.12 sec, absolute running time: 0.15 sec, cpu time: 0 sec, memory peak: 5 Mb, absolute service time: 0,41 sec