{$codepage UTF8}
TYPE TPersona = Record
                 Nombre       : String;
                 Edad         : String;
                 Sexo         : Char;
                 altura       : double;
                 colorpiel    : String;
                 colorojos    : String;
                 nacionalidad : String;
                 region       : String;
               End;
           TPersonas = array of TPersona;             
               
VAR personas : TPersonas;
    i,n:integer;  
      
PROCEDURE Ordenar(var A:TPersonas; Izq,Der: int64) ;
 VAR
   auxIzq,auxDer:int64;   
   Pivote,aux:TPersona;
 BEGIN 
   auxIzq:=Izq;
   auxDer:=Der;

   Pivote := A[(auxIzq + auxDer) div 2];  
   
   REPEAT
     while A[auxIzq].Nombre < Pivote.Nombre do Inc(auxIzq); 
     while A[auxDer].Nombre > Pivote.Nombre do Dec(auxDer); 
     if auxIzq <= auxDer then
     begin
       //intercambio
       aux := A[auxIzq];
       A[auxIzq] := A[auxDer];
       A[auxDer] := aux;
       
       Inc(auxIzq);
       Dec(auxDer);
     end;
   UNTIL auxIzq > auxDer;
   
   if auxDer > Izq then Ordenar(A,Izq,auxDer);
   if auxIzq < Der then Ordenar(A,auxIzq,Der); 
END;
    
BEGIN  
  Write('Ingrese numero de registros a procesar : ');Readln(n);
  Setlength(personas,n);
  for i:=0 to n do
    Begin
      Writeln('Registro #',i);
      Write('Nombre       : ');Readln(personas[i].Nombre);
      Write('Edad         : ');Readln(personas[i].Edad);
      Write('Sexo         : ');Readln(personas[i].Sexo);
      Write('Altura       : ');Readln(personas[i].Altura);
      Write('Color Piel   : ');Readln(personas[i].ColorPiel);
      Write('Color Ojos   : ');Readln(personas[i].ColorOjos);
      Write('Nacionalidad : ');Readln(personas[i].Nacionalidad);
      Write('Region       : ');Readln(personas[i].Region);
    End;
    
  Writeln('ordenando');  
  
  Ordenar(personas,0,n);    
  
  Writeln('Mostrando arreglo ordenado');
  for i:=0 to n do
    Begin
      Writeln('Registro #',i);
      Writeln('Nombre       : ',personas[i].Nombre);
      Writeln('Edad         : ',personas[i].Edad);
      Writeln('Sexo         : ',personas[i].Sexo);
      Writeln('Altura       : ',personas[i].Altura:4:2);
      Writeln('Color Piel   : ',personas[i].ColorPiel);
      Writeln('Color Ojos   : ',personas[i].ColorOjos);
      Writeln('Nacionalidad : ',personas[i].Nacionalidad);
      Writeln('Region       : ',personas[i].Region);
    End;
  Write('Presione enter para terminar ...');
  Readln;  
END. 

{$codepage UTF8}
TYPE TEquipo = Record
                 Equipo       : String;
                 PruebaA,PruebaB,PruebaC,PruebaD:longword;
                 Media:double;
               End;
           TEquipos = array of TEquipo;             
               
VAR Equipos : TEquipos;
    i,n:integer;        

PROCEDURE Ordenar(var A:TEquipos; Izq,Der: int64) ;
 VAR
   auxIzq,auxDer:int64;   
   Pivote,aux:TEquipo;
BEGIN 
   auxIzq:=Izq;
   auxDer:=Der;

   Pivote := A[(auxIzq + auxDer) div 2];  
   
   REPEAT
     while A[auxIzq].Media > Pivote.Media do Inc(auxIzq); 
     while A[auxDer].Media < Pivote.Media do Dec(auxDer); 
     if auxIzq <= auxDer then
     begin
       //intercambio
       aux := A[auxIzq];
       A[auxIzq] := A[auxDer];
       A[auxDer] := aux;
       
       Inc(auxIzq);
       Dec(auxDer);
     end;
   UNTIL auxIzq > auxDer;
   
   if auxDer > Izq then Ordenar(A,Izq,auxDer);
   if auxIzq < Der then Ordenar(A,auxIzq,Der); 
END;
    
BEGIN  
  Write('Ingrese numero de Equipos a procesar : ');Readln(n);
  Setlength(Equipos,n);
  for i:=0 to n do
    Begin
      Write('Equipo #  ',i,'   :  ');Readln(Equipos[i].Equipo);
      Write('Resultado Prueba A         : ');Readln(Equipos[i].PruebaA);
      Write('Resultado Prueba B         : ');Readln(Equipos[i].PruebaB);
      Write('Resultado Prueba C         : ');Readln(Equipos[i].PruebaC);
      Write('Resultado Prueba D         : ');Readln(Equipos[i].PruebaD);
      Equipos[i].Media:=(Equipos[i].PruebaA+
                         Equipos[i].PruebaB+
                         Equipos[i].PruebaC+
                         Equipos[i].PruebaD)/4
    End;
    
  Writeln('ordenando');  
  
  Ordenar(Equipos,0,n);    
  
  Writeln('Lista de resultados');  
  Writeln('Equipo    Prueba A  Prueba B   Prueba C    Prueba D    Media');
  for i:=0 to n do    
       writeln(Equipos[i].Equipo:10,
               Equipos[i].PruebaA:8,'  ',
               Equipos[i].PruebaB:8,'  ',
               Equipos[i].PruebaC:8,'  ',
               Equipos[i].PruebaD:8,'  ',
               Equipos[i].Media:4:4);    
  Write('Presione enter para terminar ...');
  Readln;  
END.

{$codepage UTF8}
TYPE TArticulo = Record
                 Codigo  : String;
                 Dia,Mes:String[2];
                 Anio:String[4];
                 fechaiso:String[8];
               End;
           TArticulos = array of TArticulo;             
               
VAR Articulos : TArticulos;
    i,n:integer;        

PROCEDURE Ordenar(var A:TArticulos; Izq,Der: int64) ;
 VAR
   auxIzq,auxDer:int64;   
   Pivote,aux:TArticulo;   
BEGIN 
   auxIzq:=Izq;
   auxDer:=Der;

   Pivote := A[(auxIzq + auxDer) div 2];  
   
   REPEAT                        
     
     while A[auxIzq].fechaiso < Pivote.fechaiso do Inc(auxIzq);
     while A[auxDer].fechaiso > Pivote.fechaiso do Dec(auxDer);
     
     if auxIzq <= auxDer then
     begin
       //intercambio
       aux := A[auxIzq];
       A[auxIzq] := A[auxDer];
       A[auxDer] := aux;
       
       Inc(auxIzq);
       Dec(auxDer);
     end;
   UNTIL auxIzq > auxDer;
   
   if auxDer > Izq then Ordenar(A,Izq,auxDer);
   if auxIzq < Der then Ordenar(A,auxIzq,Der); 
END;
    
BEGIN  
  Write('Ingrese numero de Articulos a procesar : ');Readln(n);
  Setlength(Articulos,n);
  for i:=0 to n do
    Begin
      Write('Codigo #  ',i,'   :  ');Readln(Articulos[i].Codigo);
      Write('Dia         : ');Readln(Articulos[i].Dia);
      Write('Mes         : ');Readln(Articulos[i].Mes);
      Write('Anio         : ');Readln(Articulos[i].Anio);               
      Articulos[i].Anio:=StringofChar('0',4-length(Articulos[i].Anio))+Articulos[i].Anio;
      Articulos[i].Mes:=StringofChar('0',2-length(Articulos[i].Mes))+Articulos[i].Mes;
      Articulos[i].Dia:=StringofChar('0',2-length(Articulos[i].Dia))+Articulos[i].Dia;
      Articulos[i].fechaiso:=Articulos[i].Anio+Articulos[i].Mes+Articulos[i].Dia;      
    End;
    
  Writeln('ordenando');  
  
  Ordenar(Articulos,0,n);    
  
  Writeln('Lista de Articulos');  
  Writeln('codigo     Antiguedad');
  for i:=0 to n do
       writeln(Articulos[i].Codigo:10,'   ',
               Articulos[i].Dia,'/',
               Articulos[i].Mes,'/',
               Articulos[i].Anio);    
  Write('Presione enter para terminar ...');
  Readln;  
  
END.

{$codepage UTF8}
Type  TMatriz= array of array of longword;             

PROCEDURE Ordenar(var A:TMatriz; Izq,Der: int64;n:longword) ;
 VAR
   auxIzq,auxDer:int64;   
   Pivote,aux:longword;
   i:int64;
BEGIN 
   auxIzq:=Izq;
   auxDer:=Der;

   i:=(auxIzq + auxDer) div 2;
   Pivote := A[i div n, i mod n];
   
   REPEAT
     while A[auxIzq div n,auxIzq mod n] < Pivote do Inc(auxIzq);
     while A[auxDer div n,auxDer mod n] > Pivote do Dec(auxDer);
     if auxIzq <= auxDer then
     begin
       //intercambio
       aux := A[auxIzq div n, auxIzq mod n];
       A[auxIzq div n, auxIzq mod n] := A[auxDer div n,auxDer mod n];
       A[auxDer div n,auxDer mod n] := aux;
       
       Inc(auxIzq);
       Dec(auxDer);
     end;
   UNTIL auxIzq > auxDer;
   
   if auxDer > Izq then Ordenar(A,Izq,auxDer,n);
   if auxIzq < Der then Ordenar(A,auxIzq,Der,n); 
END;
              
VAR  MiMatriz:TMatriz;
         i,j,m,n:longword;
             
BEGIN    
  m:=5;n:=4;
  SetLength(MiMatriz,m,n);  
  for i:=0 to m-1 do
    for j:=0 to n-1 do    MiMatriz[i,j]:=random(20); 
  
  for i:=0 to m-1 do
  Begin
    for j:=0 to n-1 do    Write(MiMatriz[i,j]:10);
    Writeln
  End; 
    
  Ordenar(MiMatriz,0,(m*n)-1,n);  
  
  Writeln('Ordenando');
  
  for i:=0 to m-1 do
  Begin
    for j:=0 to n-1 do    Write(MiMatriz[i,j]:10);
    Writeln
  End;   
  
  Write('Presione enter para terminar ...');
  Readln;  
END. 

{$codepage UTF8}
Type  TMatriz= array of array of longword;             

PROCEDURE Ordenar(var A:TMatriz; Izq,Der: int64;n:longword) ;
 VAR
   auxIzq,auxDer:int64;   
   Pivote,aux:longword;
   i:int64;
BEGIN 
   auxIzq:=Izq;
   auxDer:=Der;

   i:=(auxIzq + auxDer) div 2;
   Pivote := A[i div n, i mod n];
   
   REPEAT
     while A[auxIzq div n,auxIzq mod n] > Pivote do Inc(auxIzq);
     while A[auxDer div n,auxDer mod n] < Pivote do Dec(auxDer);
     if auxIzq <= auxDer then
     begin
       //intercambio
       aux := A[auxIzq div n, auxIzq mod n];
       A[auxIzq div n, auxIzq mod n] := A[auxDer div n,auxDer mod n];
       A[auxDer div n,auxDer mod n] := aux;
       
       Inc(auxIzq);
       Dec(auxDer);
     end;
   UNTIL auxIzq > auxDer;
   
   if auxDer > Izq then Ordenar(A,Izq,auxDer,n);
   if auxIzq < Der then Ordenar(A,auxIzq,Der,n); 
END;
              
VAR  MiMatriz:TMatriz;
         i,j,m,n:longword;
             
BEGIN    
  m:=5;n:=4;
  SetLength(MiMatriz,m,n);  
  for i:=0 to m-1 do
    for j:=0 to n-1 do    MiMatriz[i,j]:=random(20); 
  
  for i:=0 to m-1 do
  Begin
    for j:=0 to n-1 do    Write(MiMatriz[i,j]:10);
    Writeln
  End; 
    
  Ordenar(MiMatriz,0,(m*n)-1,n);  
  
  Writeln('Ordenando');
  
  for i:=0 to m-1 do
  Begin
    for j:=0 to n-1 do    Write(MiMatriz[i,j]:10);
    Writeln
  End;   
  
  Write('Presione enter para terminar ...');
  Readln;  
END. 

{Codepage utf8}
USES sysutils,Listas;


FUNCTION BusquedaLineal(A:LNaturales; var pos:LNaturales;k:qword):boolean;
VAR i,j:longword;      
  BEGIN
     i:=0;j:=0;
     BusquedaLineal:=false;     
     for i:=0 to high(A) do 
       Begin
          if k=A[i] then begin                                    
                          SetLength(pos,length(pos)+1);
                          pos[j]:=i; j:=j+1
                        end;                                 
       End;     
     if length(pos)>0 then BusquedaLineal:=true;     
  END;

VAR A:LNaturales;      
     pos:LNaturales; 
     k:qword;
     i:longword;

BEGIN
   SetLength(A,3000000);
    ListaAleatoria(A,18446744073709551615);    
    Write('Ingrese un numero a buscar: '); Readln(k);
    
    Writeln(' Busqueda Lineal o Secuencial  ');
    if BusquedaLineal(A,pos,k)
       then  Begin
                    Writeln('El numero se encontro ', length(pos), ' veces');
                    Write('En las siguientes posiciones: ');
                    for i :=0 to  high(pos) do
                       Begin
                           if (i mod 15)=0 then writeln;
                           Write(pos[i],'  ')                           
                       End        
                End    
       else Writeln('No existe')
END.

{$codepage utf8}
USES Listas;


FUNCTION BusquedaCadena(patron,cad:unicodestring; var pos:LNaturales):boolean;
VAR
  abecedario:array [0..65535] of word; //Todo el BMP UTF16
  i,j,k:longword;       
  c:Widechar;
BEGIN 
   for i:= 0 to 65535 do abecedario[i]:=length(patron);
   for i:=1 to length(patron)-1 do abecedario[ord(patron[i])]:=length(patron)-i; 
   
   BusquedaCadena:=false;   
   i:=length(patron);  // pos:=0;  
   j:=i;   
   k:=i;
   c:=cad[k];


   While  (k<=length(cad)) do begin  
    while (j>0) and (k<=length(cad)) do   
      Begin
       if patron[j] <> cad[i]
          then begin
                 //si hay discrepancia saltar segun abecedario  
                 k:=k+abecedario[ord(c)];        
                 i:=k;   
                 c:=cad[k];
                 j:=length(patron)
                end    
          else  begin  
                 //caso contrario comparar hacia atras.  
                  i:=i-1;j:=j-1
                end;         
      End;
      if j=0 then 
         Begin      
            setlength(pos, length(pos)+1);
            pos[high(pos)]:=i+1; 
            i:=i+1+length(patron)+length(patron);
            j:=length(patron);            
            k:=i;
            c:=cad[k]
         End;       
   End;  
   if length(pos)>0 then BusquedaCadena:=true           
 END;       

VAR  cad,patron:unicodestring;
     pos:LNaturales;i:longword;

BEGIN
   cad:='El tigre comio venado, el venado fue '+
        'alimento del tigre, ahora el tigre ya '+
        'no tiene hambre'; 
   patron:='tigre';
   if BusquedaCadena(patron,cad,pos)
      then Begin
                 Writeln('tigre se encontro ',length(pos),' veces');
                  Write('En las siguientes posiciones: ');
                    for i :=0 to  high(pos) do
                       Begin
                           if (i mod 15)=0 then writeln;
                           Write(pos[i],'  ')                           
                       End        
              End   
      else Writeln('no se encontro')       
END.

{$codepage utf8}
FUNCTION BusquedaCadena(patron,cad:unicodestring; var pos:longword):boolean;
VAR
  abecedario:array [0..65535] of word;
  i,j,k:longword;      
  c:Widechar;
BEGIN 
   cad:=' '+cad+' ';  
   patron:=' '+patron+' ';
   
   for i:= 0 to 65535 do abecedario[i]:=length(patron);
   for i:=1 to length(patron)-1 do abecedario[ord(patron[i])]:=length(patron)-i; 
   
   BusquedaCadena:=false;   
   
   
   i:=length(patron);   pos:=0;  
   j:=i;
   k:=i;
   c:=cad[k];


   while (j>0) and (k<=length(cad)) do
     begin
       if patron[j] <> cad[i]
          then begin                 
                 k:=k+abecedario[ord(c)];        
                 i:=k;   
                 c:=cad[k];
                 j:=length(patron)
                end    
          else  begin                   
                  i:=i-1;j:=j-1
                end              
     End;


   if j=0 then begin
                pos:=i+1; BusquedaCadena:=true
           end;                       
END;       

VAR cad,patron:unicodestring;
    pos:longword;

BEGIN
   cad:='El colorado no encontro el color'; 
   patron:='color';   
   if BusquedaCadena(patron,cad,pos)
      then Writeln('Se encontro en : ',pos)
      else Writeln('no se encontro')       
END.