intercalar digitos

[getroz]

unit UCVector;

interface

uses SysUtils;
//uses SysUtils , UPila;


Const
MaxE = 1024;

Type

ConjuntoElementos = Array[1..MaxE] of Integer;

CEMVector = Class(Exception);

CVector = Class

Private
Dimension : Word;
Elementos : ConjuntoElementos;
Procedure Intercambiar( i,j : Word );
// Procedure QuickSort(Ini , Fin :integer);

Public
Constructor Crear;
Procedure Dimensionar( N : Word );
Procedure Adicionar( Elemento : Integer); // adiciona un elemento al vector aumentando la dimencion del vector
Procedure Insertar( Pos : Word ; Elemento : Integer); //reemplaza un elemento por otro sin aumentar la dimension
Function Elemento( Pos : Word ): Word ;
Procedure Eliminar( Pos : Word );
Function NumeroElementos : Word;
Procedure Invertir;
Procedure Rotar( N : Word );
Function BusquedaSecuencial( Elemento : Integer ) : Word;
Function BusquedaBinaria( Elemento : Integer ) : Word;
Procedure OrdenarIntercambio;
Procedure OrdenarDesc;
Procedure OrdenarBurbuja;
Procedure OrdenarShell;
// Procedure OrdenarQuickSort;
Procedure EliminarRepetidos;
Function NumeroRepetidos : Word;
Procedure OrdenarFrecuencia;
Function ComoString : String;
End;


implementation

Procedure CVector.Intercambiar( i,j : Word );
Var
Aux : Word;
Begin
Aux := Elementos[ i ];
Elementos[ i ] := Elementos[ j ];
Elementos[ j ] := Aux;
End;

//PUBLIC

Constructor CVector.Crear;
Begin
Dimension := 0;
End;

Procedure CVector.Dimensionar( N : Word );
Begin
Dimension :=N;
End;

Procedure CVector.Adicionar( Elemento : Integer);
Begin
Try
Inc( Dimension );
Elementos[ Dimension ] := Elemento;
Except
Raise CEMVector.Create('CVector.Adicionar : Fuera de RANGO...');
End;
End;

Procedure CVector.Insertar( Pos : Word ; Elemento : Integer);
Var
i : Word;
Begin
// Try
// For i := Dimension Downto Pos do
// Elementos[ i+1 ] := Elementos[ i ];
Elementos[ Pos ] := Elemento;
// Inc(Dimension)
// Except
// Raise CEMVector.Create('CVector.Insertar : Fuera de RANGO...');
// End;
End;

Function CVector.Elemento( Pos : Word ): Word ;
Begin
Result := Elementos[ Pos ];
End;

Procedure CVector.Eliminar( Pos : Word ); //quita un nuymero y reduce la dimension
Var
i : Word;
Begin
Try
For i := Pos to Dimension-1 do
Elementos[ i ] := Elementos[ i+1 ];
Dec(Dimension);
Except
Raise CEMVector.Create('CVector.Eliminar : Fuera de RANGO...');
End;
End;

Function CVector.NumeroElementos : Word;
Begin
Result := Dimension;
End;

Procedure CVector.Invertir;
Var
Media , i : Integer;
Begin
Media := Dimension div 2;
For i :=1 To Media do
InterCambiar( i , Dimension- i+1 );
End;

Procedure CVector.Rotar( N : Word );
Var
i , j , NMod ,Aux : Word;
Begin
NMod := N Mod Dimension;
For i := 1 to NMod do
Begin
Aux := Elementos[ 1 ];
For j := 2 To Dimension do
Elementos[ j-1 ] := Elementos[ j ];
Elementos[ Dimension ]:= Aux;
End;
End;

Function CVector.BusquedaSecuencial( Elemento : Integer ) : Word;
Var
Pos : Word;
Begin
Pos := 1;
While( Pos<= Dimension )and( Elementos[ Pos ]<> Elemento )do
Inc( Pos );
If( Pos > Dimension )Then
Pos := 0;
Result := Pos;
End;

Function CVector.BusquedaBinaria( Elemento : Integer ) : Word;
Var
Ini , Fin , Media :word;
Sw:boolean;
Begin
Ini := 1;
Fin := Dimension;
Sw := False;
Media := 0;
While (Ini <= Fin ) and ( not Sw ) Do
Begin
Media :=( Fin + Ini )div 2;
If( Elemento = Elementos[ Media ] )Then
Sw:=true
Else
If( Elemento < elementos[ Media ] )Then
Fin := Media - 1
Else
Ini := Media + 1;
End;
Result := Media;
End;

Procedure CVector.OrdenarIntercambio; // oredena de menor a mayor ..(ASCENDENTE)...
Var
i , j: Word;
Begin
For i := 1 to Dimension-1 do
For j := i+1 to Dimension do
if( Elementos[ j ] < Elementos[ i ] )then //para hacer de mayor a menor se invierte el simbolo < por >
Intercambiar( j , i );
End;

Procedure CVector.OrdenarBurbuja;
Var
i , j , Aux, Aux2 : Word;
Begin
Aux2:= (Dimension DIV 2)+1;
For i := 1 To Aux2-1 Do
For j := Aux2 To Dimension-i Do
If( Elementos [ j ] >Elementos [ j+1 ] )Then
Begin
Aux := Elementos [ j ];
Elementos [ j ] := Elementos [ j+1 ];
Elementos [ j+1 ] := Aux;
End;
Aux2:= (Dimension DIV 2)+1;
For i := 1 To Aux2-1 Do
For j := 1 To Aux2-1 Do
If( Elementos [ j ] <Elementos [ j+1 ] )Then
Begin
Aux := Elementos [ j ];
Elementos [ j ] := Elementos [ j+1 ];
Elementos [ j+1 ] := Aux;
End;
End;


procedure CVector.OrdenarDesc; // ordena de mayor a menor.....(DESCENDENTE)
Var
i , j: Word;
Begin
For i := 1 to Dimension-1 do
For j := i+1 to Dimension do
if( Elementos[ j ] > Elementos[ i ] )then
Intercambiar( j , i );
End;

Procedure CVector.OrdenarShell;
Var
Inter , i , j , k : Integer;
Begin
Inter := Dimension div 2;
While( Inter > 0 )Do
Begin
For i := (Inter + 1) to Dimension do
Begin
j := i - Inter;
While( j > 0)do
Begin
k := j + Inter;
If( Elementos [ j ]<=Elementos [ k ])then
j := 0
Else
Intercambiar( j, k);
j := j - Inter;
End;
End;
Inter := Inter div 2;
End;
End;
{Procedure CVector.QuickSort(Ini , Fin :integer);
Var
izq , der , central : integer;
Begin
izq := Ini;
der := Fin;
central := Elementos [(Ini+Fin)Div 2 ];
Repeat
While( Elementos[ izq ] < central )do
izq := izq + 1;
While( Elementos[ der ] > central )do
der := der - 1;
If( izq <= der)then
Begin
Intercambiar( izq ,der );
Izq := izq + 1;
der := der - 1;
End;
Until( izq > der );
If( Ini < der )then
QuickSort(Ini , der);
If( izq < Fin )then
QuickSort(izq , Fin);
End;

Procedure CVector.OrdenarQuickSort;
Var
n1,i,j,izq,der:integer;
e : TElemento;
p:TPila;
Begin
P:=TPila.Create;
E.I:=1;E.D:=dimension;
P.Adicionar(e);
While not(P.PilaVacia) Do
Begin
e:=P.ObtenerElemento;
izq:=E.I; der:=E.D;
i:=izq; j:=der;
While (i<j) Do
Begin
While (Elemento(i)<Elemento(j)) Do
Begin
inc(i);
End;
If (i<j) Then
Begin
Intercambiar(i,j);
dec(j);
End;
While ( Elemento(i)< Elemento(j)) Do
Begin
dec(j);
End;
If (i<j) Then
Begin
Intercambiar(i,j);
inc(i);
End;
End;
If (j<(der-1)) Then
begin
E.I:=i+1; E.D:=der;
P.Adicionar(e);
End;
If (i>(izq+1)) Then
Begin
E.I:=izq; E.D:=i-1;
P.Adicionar(e);
End;
end;
//QuickSort(1 , Dimension);
End; }

Procedure CVector.EliminarRepetidos;
Var
i , Aux :Word;
Begin
// OrdenarQuickSort;
Aux := Elementos[ 1 ];
i := 2;
While( i <= Dimension )do
Begin
if( Aux = Elementos[ i ] )then
Eliminar(i)
Else
Begin
Aux := Elementos[ i ];
inc(i);
End;
End;
End;

Function CVector.NumeroRepetidos : Word;
Var
i , Aux , Cont :Word;
sw : Boolean;
Begin
// OrdenarQuickSort;
Aux := Elementos[ 1 ];
i := 2;
Cont := 0;
sw := true;
While( i <= Dimension )do
Begin
if( Aux = Elementos[ i ] )then
Begin
If( sw )then
Begin
Inc(Cont);
sw :=false;
End;
End
Else
Begin
Aux := Elementos[ i ];
sw :=true;
End;
inc(i);
End;
Result := Cont;
End;

Procedure CVector.OrdenarFrecuencia;
Var
Dato , Repe :CVector;
i , j , Aux , Cant :Word;
Begin
// OrdenarQuickSort;
Dato := CVector.Crear;
Repe := CVector.Crear;
//Recuperando las frecuencias de repeticion
i := 1;
Aux := Elementos[ i ];
Cant := 1;
While( i < Dimension )do
Begin
i := i + 1;
if( Aux = Elementos[ i ] )then
Cant := Cant + 1
Else
Begin
Dato.Adicionar(Aux);
Repe.Adicionar(Cant);
Aux := Elementos[ i ];
Cant := 1;
End;
End;
Dato.Adicionar(Aux);
Repe.Adicionar(Cant);
//Ordenando por frecuencia de repeticion
//podemos apropiarnos cualquier tipo de ordenamiento
//solo por facilidad utilizaremos el mas sencillo(por Intercambio).
For i := 1 to Repe.Dimension-1 do
For j := i+1 to Repe.Dimension do
If( Repe.Elemento( j ) < Repe.Elemento( i ) )then
Begin
Repe.Intercambiar( j , i );
Dato.Intercambiar( j , i );
End;
//una vez ordenado por frecuencia podemos reasignar los valores
Dimension := 0;
for i:= 1 to Dato.Dimension do
Begin
Cant := Repe.Elemento( i );
Aux := Dato.Elemento( i );
for j:= 1 to Cant do
Adicionar(Aux);
End;

End;

Function CVector.ComoString : String;
Var
Cad : String;
Pos : Integer;
Begin
If( Dimension = 0 )then
Cad:='[]'
Else
Begin
Cad :='['+ IntToStr( Elementos[ 1 ] );
For Pos := 2 to Dimension do
Cad := Cad +','+ IntToStr( Elementos[ Pos ] );
Cad := Cad +']';
End;
Result := Cad;
End;

end.