intercalar digitos

luisito2011 · #1 07-05-2011

ola.. tengo una duda.. con esta funcion..
deveria intercalarme digitos de A,b ah C
ejem.... si tengo a:=159 , b:= 267, toncej c:= 125697

Código Delphi [-]function intercalar( var a,b,c:cnumeronatural):integer;
var aux,pos:integer;
begin
pos:=1;
aux:=0;
while pos < = a.numerodigitos do
   begin
     if aux = 0 then
        begin
           c.asignarvalor((c.obtenervalor * 10) + a.digito(pos)));
           aux:=1;
           end else
             begin
                 c.asignarvalor((c.obtenervalor * 10) + b.digito(pos)));
                 pos:=pos+1; 
                aux:=0;             
       end;
        end;       
     end;
end;

Se supone que eso deveria funcionar.. pero cuando corro el programa con
F7... en la parte que esta rojo... no pasa nada.. es como si no existiera..
por que ??

ejem.. a:= 135 , b:=246 -->c:=123456
pero... me sale solo c:=135

saludos..
ah.. es el penultimo ejercicio de mi practico de naturales

ahora sigue vectores

espero seguir recibiendo ayuda... la verdad que es muy bueno el foro... bueno.. bye.. vectores dios... desenme suerte

[gatosoft] · #2 08-05-2011

Bueno amigo,

hice la prueba en mi equipo y comiló perfecto... estos problemas me sucedian en Delphi 4 y 5(hace años)...

La explicación que encontré en su momento fue que el compilador intenta trabajar de "forma inteligente", eliminando variables basura, es decir, la que el considera que son inoficiosas por que se declaran, se asignan pero no se usan realmente para nada...

En tu caso no debería ser asi, pues la sentencia:

Código Delphi [-]if aux = 0 then

deberia forzar al compilador a que se tuviera en cuenta... ¿que version de Delphi Utilizas?...

No se si alguien mas tenga una idea sobre esto, tal vez alguna opcion del compilador que haya que ajustar???

intenta algo diferente, para forzar al compilador a que tenga en cuenta tu variable...:

Código Delphi [-]//esto es solo una idea...
function intercalar( var a,b,c:cnumeronatural):integer;
var aux,pos:integer;
begin
pos:=1;
aux:=0;
while pos < = a.numerodigitos do
   begin
    inc(aux);
     if (aux mod 2) = 0 then
        begin
           c.asignarvalor((c.obtenervalor * 10) + a.digito(pos)));
           end else
             begin
                 c.asignarvalor((c.obtenervalor * 10) + b.digito(pos)));
                 pos:=pos+1; 
       end;
    end;       
     end;
end;

Por otro lado, para la proxima, recuerda que cada nuevo hilo es una hstoria nueva y debes entregar toda la información posible... me refiero a que no todos saben que tienes una unidad llamada Caja1, que es la base de tus tareas...

Código Delphi [-]Unit Caja1;
Interface
Uses
    SysUtils,dialogs;
Type
    CEMNumeroNatural = Class(Exception);
    CNumeroNatural = Class
      Private
              Valor : Cardinal;
      Public
             Constructor Crear;
             Procedure AsignarValor( NuevoValor : Cardinal);
             Procedure InsertarDigito( Posicion : Byte ; Digito : Byte);
             Procedure EliminarDigito( Posicion : Byte );
             Procedure Invertir;
             Function  ObtenerValor : Cardinal;
             Function  NumeroDigitos : Byte;
             Function  Digito( Posicion : Byte ) : Byte;
             Function  EsPrimo : Boolean;
             Function  EsPar : Boolean;
             Function  SumarDigitos : Byte;
             Function  DigitosPares : Byte;
             Function  DigitosImpares : Byte;

    End;
Implementation
//PUBLIC
Constructor CNumeroNatural.Crear;
Begin
     inherited create;
     Valor := 0;
End;
Procedure CNumeroNatural.AsignarValor( NuevoValor : Cardinal);
Begin
     Valor := NuevoValor;
End;
Procedure CNumeroNatural.InsertarDigito     ( Posicion : Byte ; Digito : Byte);
Var
   Aux , Aux2 , Digi :Cardinal;
Begin
     Aux := Valor;
     If( Posicion > 0)and( Posicion <= NumeroDigitos )Then
     Begin
          Aux2 := 0;           Digi := 0;
          While( Digi <= NumeroDigitos-Posicion )do
          Begin
               Aux2 := ( Aux2 * 10 ) + Aux Mod 10;    Aux  :=   Aux Div 10;      Inc( Digi );
          End;
          Aux := ( Aux * 10 ) + Digito;//Inserta Digito
          While( Digi > 0 )do
          Begin
             Aux   := ( Aux * 10 ) + ( Aux2 Mod 10 );  Aux2  :=   Aux2 Div 10;      Dec( Digi );
          End;
          Valor := Aux;
     End
     Else
       Raise CEMNumeroNatural.Create
         ('CNumeroNatural.InsertarDigito: Error Fuera de RANGO...');
End;
Procedure CNumeroNatural.EliminarDigito( Posicion : Byte );
Var
   Aux , Aux2 , Digi :Cardinal;
Begin
     Aux := Valor;
     If( Posicion > 0)and( Posicion <= NumeroDigitos )Then
     Begin
          Aux2 := 0;
          Digi := 0;
          While( Digi < NumeroDigitos-Posicion )do
          Begin
               Aux2 := ( Aux2 * 10 ) + Aux Mod 10;
               Aux  :=   Aux Div 10;
               Inc( Digi );
          End;
          Aux := ( Aux Div 10 );//Elimina Digito
          While( Digi > 0 )do
          Begin
             Aux   := ( Aux * 10 ) + ( Aux2 Mod 10 );
             Aux2  :=   Aux2 Div 10;
             Dec( Digi );
          End;
          Valor := Aux;
     End
     Else
       Raise CEMNumeroNatural.Create
            ('CNumeroNatural.EliminarDigito: Error Fuera de RANGO...');
End;
Procedure CNumeroNatural.Invertir;
Var
   Aux , Aux2 , i :Cardinal;
Begin
     Aux2 := Valor;
     Aux  := 0;
     i    := 0;
     While( i < NumeroDigitos )do
     Begin
          Aux  := ( Aux * 10 ) + Aux2 Mod 10;
          Aux2 :=   Aux2 Div 10;
          Inc( i );
     End;
     Valor := Aux;
End;
Function  CNumeroNatural.ObtenerValor : Cardinal;
Begin
     Result := Valor;
End;
Function  CNumeroNatural.NumeroDigitos : Byte;
Var
   Aux : Cardinal;
   Cant : Byte;
Begin
     Aux := Valor;
     Cant := 0;
     Repeat
        Aux := Aux Div 10;
        Inc( Cant );
     Until(Aux = 0);
     Result := Cant;
End;
Function  CNumeroNatural.Digito( Posicion : Byte ) : Byte;
Var
   Aux : Cardinal;
   Digi , Digito : Byte;
Begin
     Aux := Valor;
     Digi := 0;
     if( Posicion > 0 )and( Posicion <= NumeroDigitos )then
     Begin
          Repeat
             Digito := Aux Mod 10;
             Aux := Aux Div 10;
             Inc( Digi );
          Until( Digi > NumeroDigitos-Posicion );
          Result := Digito;
     End
     Else
         Raise CEMNumeroNatural.Create
               ('CNumeroNatural.Digito: Error Fuera de RANGO...');
End;




Function  CNumeroNatural.EsPrimo : Boolean;
Var
   i , n : word;
   sw  : boolean;
Begin
      sw := true;
      i  := 2;
      while(i <= ( Valor div 2 ) ) and ( sw = true ) do
      Begin
           n := Valor mod i;
           if( n = 0 )then
              sw := false;
           i := i + 1 ;
      End;
      result := sw;
End;
Function  CNumeroNatural.EsPar : Boolean;
Begin
  Result := (valor mod 2)= 0 ;
End;
Function  CNumeroNatural.SumarDigitos : Byte;
Var
   Aux , Suma : Cardinal;
Begin
     Aux := Valor;
     Suma := 0;
     Repeat
        Suma := Suma +( Aux Mod 10 );
        Aux := Aux Div 10;
     Until( Aux = 0 );
     Result := Suma;
End;
Function  CNumeroNatural.DigitosPares : Byte;
Var
   Aux : Cardinal;
   Cant , Digito : Byte;
Begin
     Aux := Valor;
     Cant := 0;
     Repeat
        Digito := Aux Mod 10;
        Aux := Aux Div 10;
        If( Digito mod 2 = 0 )Then
            Inc( Cant );
     Until( Aux = 0 );
     Result := Cant;
End;
Function  CNumeroNatural.DigitosImpares : Byte;
Begin
     Result := NumeroDigitos-DigitosPares;
End;
End.

y aqui la prueba que hice:

Código Delphi [-]uses Caja1;

{$R *.dfm}

function intercalar( var a,b,c:cnumeronatural):integer;
var aux,pos:integer;
begin
pos:=1;
aux:=0;
while pos <= a.numerodigitos do
   begin
     if aux = 0 then
        begin
           c.asignarvalor((c.obtenervalor * 10) + a.digito(pos));
           aux:=1;
        end else
             begin
                 c.asignarvalor((c.obtenervalor * 10) + b.digito(pos));
                 pos:=pos+1;
                aux:=0;
             end;
   end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var a,b,c : CNumeroNatural;

begin
  Try
    a := CNumeroNatural.Crear;
    b := CNumeroNatural.Crear;
    c := CNumeroNatural.Crear;

    a.AsignarValor(StrToInt(Edit1.Text));
    b.AsignarValor(StrToInt(Edit2.Text));
    intercalar(a,b,c);

    Edit3.Text := IntTostr(c.ObtenerValor);
  Finally
    a.free;
    b.free;
    c.free;
  End;
end;

Un saludo,

luisito2011 · #3 08-05-2011

bueno.. 1ro.. tengo delphi 2010

2do.. cuando probe otra vez mi function.. funciono--

3ro.. se me olvido poner mi caja .. unit

lo siento
4to.. mi function tiene un error

solo funciona si ..
A:= es mayor o menor .. de numerodigitos que B..
y si B.. es mayor que A..o si es menor que A no sirve..
error //fuera de rango//
...que puedo modificar para que sirva no inporta si A o B
es mayor o menor de numerodigitos..
5to.. bueno no hay un 5to..

saludos.. y gracias..

[gatosoft] · #4 08-05-2011

Podrias probar...

Código Delphi [-]function intercalar( var a,b,c:cnumeronatural):integer;
var pos:integer;
    tamanomaximo: Integer;
begin

if a.numerodigitos > b.numerodigitos then
   tamanomaximo := a.numerodigitos
else
   tamanomaximo := b.numerodigitos;

pos:=1;
while pos <= tamanomaximo do
   begin
     if a.numerodigitos >= Pos then
        c.asignarvalor((c.obtenervalor * 10) +  a.Digito(POS));

     if b.numerodigitos >= Pos then
        c.asignarvalor((c.obtenervalor * 10) +  b.Digito(POS));

   pos:=pos+1;
   end;
end;

getroz · #5 04-12-2012

necesito intercalar los elementos de dos vectores y estopy utilizando la siguiente unidad....me pueden ayudar????...

getroz · #6 04-12-2012

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.

[gatosoft] · #7 04-12-2012

Bueno antes que nada, bienvenido al club...

Y pronto pasará por aquí un moderador llamado Casimiro Noveti y te hará algunas observaciones... asi que me adelanto:

1) Para un mayor entendimiento de tu problema, puedes poner tu código enmarcado en las etiquetas: [Delphi.] y [/Delphi.] (sin los puntos)... de esta forma tu código será mas legible...
2) Normalmente empezamos un nuevo hilo para cada problema, aunque parezca el mismo, haciendo referencia con un link a algún post anterior... Date un paseo por la guía de estilo para que te informes mejor...
3) ¿Tu problema es "el mismo"? ¿que quieres decir con eso?, si es el mismo, ¿no te sirve la misma solución?, ¿en que falla tu unidad?... lo digo porque no siempre tenemos el tiempo de tomar tu código, compilarlo y analizarlo... debes ayudarnos un poco con algún análisis, ya que es muy común por aquí que la gente pase para que le ayudemos a hacer la tarea con código que ellos mismos no entienden....

Un saludo,

Código Delphi [-]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 ] 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(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.

Temas Similares
Tema	Autor	Foro	Respuestas	Último mensaje
Muchos digitos...¿es posible?	Carnash	Varios	2	21-02-2009 23:17:26
FastReport - Matriz de Puntos - Dos copias sin intercalar	ewitte	Impresión	4	19-07-2008 16:35:58
intercalar paginas con fastreport	mferrero	Impresión	1	26-02-2008 13:36:54
Intercalar Variable en SQL...	foetus	SQL	7	09-07-2007 02:21:28
Ingresar un núm de 10 digitos...	coronado	Varios	1	12-10-2006 13:49:18