Shellsort

user.paulo · 10 de dezembro de 2009

Olá pessoal, tudo beleza?

seguinte.. to fazendo uma ordenação por shellsort, compila normal sem zica..

mais quando ele entra na procedure ta dando runtime error..

segue o cod abaixo, da uma força ae pessoal ;D

program shell_sort;
Uses CRT;
Const N=5;
Type
 Tp_Vetor = array [1..N] of integer;

Var
 Vetor:Tp_Vetor;
 i:integer;
//-----------------------------------------------------------------------------------
Procedure ShellSort (Vetor:Tp_Vetor);
Var
 fim, indice,indice2, aux, posicao:integer;

Begin
  Dist := (N Div 2)+1;
  fim:= N - Dist;
  Posicao:=Dist;
 For indice:=dist downto 1 do
 Begin
  For indice2:=1 to fim do
  Begin
    If(Vetor[indice2] <= Vetor[posicao]) then
    Begin
      posicao:=posicao + 1;
    end
    Else
    Begin
      aux:= Vetor[posicao];
      vetor[posicao]:=Vetor[indice];
      Vetor[indice]:= aux;
      posicao:=posicao+1;
    end;
  end;
 end;
end;
//-------------------------------------------------------------------------------------
Begin
CLRSCR;
  Writeln('Vetor a ser verificado');
  randomize;
  For I:=1 to N do
  Begin
    Vetor[i]:= random(100);
    Write(Vetor[i], ' | ');
  end;
  Writeln('');
 Shellsort(Vetor);
 Writeln('Vetor ordenado');
 For i:=1 to N do
 Begin
    Write(vetor[i], ' | ');
 end;
 Readln;
end.

user.paulo · 14 de dezembro de 2009

Pessoal, não precisa mais nao.. ja consegui resolver..

valeu :}

Mog.Lucas · 21 de dezembro de 2009

Olá!

Poderia postar a solução encontrada?

Abraços!

Anderson Eiji · 23 de julho de 2016

Estou fazendo por lista. O programa compilar, mas ao digitar um valor para o vetor, logo de inicio o programa trava e fala que "a posição zero está fora dos limites do vetor". Se puderem me ajudar, agradeço

Program Shellsort_LISTA_ENCADEADA;
const
    inicioArranjo = 1;
         MaxTam = 255;
type
     Apontador = integer;
     TipoItem = record
           Chave: string;
               end;
    TipoLista = record
            item: array [1..MaxTam] of TipoItem;
                        Primeiro: Apontador;
                        Ultimo: Apontador;
                end;
                indice = 1..MaxTam;
var
 elemento: TipoLista;            
 opcao: integer;
     c:TipoItem; 

procedure inserir(x:TipoItem; var elemento:TipoLista);
begin
   if (elemento.Ultimo > MaxTam)
      then  writeln ('O programa tem capacidade máxima de 255 caracteres!')
            else 
              begin
                 elemento.Item[elemento.Ultimo]:=x;
                 elemento.Ultimo:=elemento.Ultimo + 1;
              end;
end;

procedure FazListaVazia (var elemento: TipoLista);
begin
     elemento.Primeiro:=inicioArranjo;
     elemento.Ultimo:=elemento.Primeiro;
     writeln;
     writeln('        vetor dos elementos zerado com sucesso!');
end;

function Vazia(var elemento:TipoLista):boolean;
begin
  Vazia:=elemento.Primeiro=elemento.Ultimo;
end;                 
              
procedure ShellSort(var elemento:TipoLista);
var i, j: Indice;
       h: integer;
       x: TipoItem;
begin
  gotoxy(11, 24); writeln('Aguarde... Ordenando - ShellSort !');
  h := 1;
  repeat h := 3 * h + 1 until h > elemento.Ultimo;
  repeat
    h := h div 3;
    for i := h + 1 to elemento.Ultimo do
    begin
      x.Chave := elemento.item.Chave; //normal é só x;
      j := i;
      while (j > h) and (elemento.item[j - h].Chave > x.Chave) do
      begin
        elemento.item[j] := elemento.item[j - h];
           j := j - h;
      end;
      elemento.item[j] := x;
    end;
  until h = 1;
  gotoxy(11, 24); writeln('Atencao.... Ordenacao Concluida !');
 end;

procedure Parada;
var Tecla: char;
begin 
  gotoxy(60, 25); write('Pressione algo !');
  Tecla := readkey;
end;


procedure imprimir(var elemento: TipoLista);
var Nl, Nc: byte;
         i: Indice;
begin
  clrscr;
  gotoxy(01, 24); writeln('Mensagem: Aguarde... Exibe Elementos !');
  Nl := 1;
  Nc := 1;
  for i:= elemento.Primeiro to (elemento.Ultimo - 1) do  
  begin
    gotoxy(Nc, Nl); write(i:5,'- ',elemento.Item.Chave);
    Nl := Nl + 1;
    if   Nl = 22
         then begin
                Nl := 1;
                Nc := Nc + 15;
                if   Nc > 65
                     then begin
                            Parada;
                            clrscr;
                            gotoxy(01, 24); writeln('Mensagem: Aguarde... Exibe Elementos !');
                            Nc := 1;
                          end;
              end;
  end;
  gotoxy(11, 24); writeln('Atencao... Exibicao Concluida !');
end;

 

//  programa principal
Begin
  repeat
    clrscr;  //limpa a tela 
    writeln('(1) digitar o elemento.');
    writeln('(2) imprimir elemento ordenado por Shellsort.');
    writeln('(3) zerar a lista de elementos.');
        writeln('(4) sair do programa.');  
Writeln; //imprime uma linha em branco    
    write(' digite a opção desejada:  '); readln(opcao);
    
    case opcao of
     
     1: begin 
         writeln ('     você escolheu a opção 1.  ');
         writeln;
         write('digite o elemento a ser digitado: ');readln(c.Chave);
         inserir(c,elemento);
        end;
         
     2: begin
          writeln ('     você escolheu a opção 2.  ');
          writeln;
          Shellsort(elemento);
          imprimir(elemento);
         end;
         
     3: begin
          writeln ('     você escolheu a opção 3.  ');
          writeln;
          FazListaVazia(elemento);
         end;
             
     4: writeln ('     você escolheu a opção 4.  ');   
     else writeln (' você digitou uma opção invalida.  ');
    end;
  writeln;
  writeln('Digite qualquer tecla para continuar .....');
  readkey;
until (opcao = 4);
end.

Simon Viegas · 24 de julho de 2016

Olá @Anderson Eiji,

20 horas atrás, Anderson Eiji disse:

Estou fazendo por lista. O programa compilar, mas ao digitar um valor para o vetor, logo de inicio o programa trava e fala que "a posição zero está fora dos limites do vetor". Se puderem me ajudar, agradeço

Creio que faltou inicializar a LISTA, chamado o FazListaVazia() antes de adicionar:

BEGIN
FazListaVazia(elemento);
...

Ou você coloca uma verificação antes de adicionar, no caso, sugerindo inicializar manualmente pela opção 3.

No aguardo.

Anderson Eiji · 24 de julho de 2016

Boa tarde, @Simon Viegas

Agora o erro é outro. Eu armazeno os valores de um a um, ai depois quando eu seleciono a opção 2 para ordenar e imprimir, não aparece todos os valores ordenados

Program Shellsort_LISTA_ENCADEADA_ARRANJO;
const
    inicioArranjo = 1;
         MaxTam = 255;
type
     Apontador = integer;
     TipoItem = record
           Chave: string;
               end;
      indice = 1..MaxTam;
    TipoLista = record
            item: array [indice] of TipoItem;
						Primeiro: Apontador;
						Ultimo: Apontador;
				end;
				
var
 elemento: TipoLista;			
 opcao: integer;
     c:TipoItem; 

procedure inserir(x:TipoItem; var elemento:TipoLista);
begin
   elemento.Ultimo:=1;
   if (elemento.Ultimo > MaxTam)
      then  writeln ('O programa tem capacidade máxima de 255 caracteres!')
			else 
			  begin
			     elemento.Item[elemento.Ultimo]:=x;  // erro ao entrar com um valor: posição 0 está fora dos limites do vetor
			     elemento.Ultimo:=elemento.Ultimo + 1;
			  end;
end;

procedure FazListaVazia(var elemento: TipoLista);
begin
	 elemento.Primeiro:=inicioArranjo;
	 elemento.Ultimo:=elemento.Primeiro;
	 writeln;
	 writeln('        vetor dos elementos zerado com sucesso!');
end;

function Vazia(var elemento:TipoLista):boolean;
begin
  Vazia:=elemento.Primeiro=elemento.Ultimo;
end;				 
			  
procedure ShellSort(var elemento:TipoLista);
var i, j: Indice;
       h: integer;
       x: TipoItem;
begin
  gotoxy(11, 24); writeln('Aguarde... Ordenando - ShellSort !');
  h := 1;
  repeat h := 3 * h + 1 until h > elemento.Ultimo;
  repeat
    h := h div 3;
    for i := h + 1 to elemento.Ultimo do
    begin
      x.Chave := elemento.item[i].Chave; //normal é só x;
      j := i;
      while (j > h) and (elemento.item[j - h].Chave > x.Chave) do
      begin
        elemento.item[j] := elemento.item[j - h];
           j := j - h;
      end;
      elemento.item[j] := x;
    end;
  until h = 1;
  gotoxy(11, 24); writeln('Atencao.... Ordenacao Concluida !');
 end;

procedure Parada;
var Tecla: char;
begin 
  gotoxy(60, 25); write('Pressione algo !');
  Tecla := readkey;
end;


procedure imprimir(var elemento: TipoLista);
var Nl, Nc: byte;
         i: Indice;
begin
  clrscr;
  gotoxy(01, 24); writeln('Mensagem: Aguarde... Exibe Elementos !');
  Nl := 1;
  Nc := 1;
  for i:= elemento.Primeiro to (elemento.Ultimo) do //tava: elemento.Ultimo - 1 
  begin
    gotoxy(Nc, Nl); write(i:5,'- ',elemento.Item[i].Chave);
    Nl := Nl + 1;
    if   Nl = 22
         then begin
                Nl := 1;
                Nc := Nc + 15;
                if   Nc > 65
                     then begin
                            Parada;
                            clrscr;
                            gotoxy(01, 24); writeln('Mensagem: Aguarde... Exibe Elementos !');
                            Nc := 1;
                          end;
              end;
  end;
  gotoxy(11, 24); writeln('Atencao... Exibicao Concluida !');
end;

//  programa principal
Begin
FazListaVazia(elemento);
  repeat
    clrscr;  //limpa a tela 
    writeln('(1) digitar o elemento.');
    writeln('(2) imprimir elemento ordenado por Shellsort.');
    writeln('(3) zerar a lista de elementos.');
		writeln('(4) sair do programa.');  
Writeln; //imprime uma linha em branco    
    write(' digite a opção desejada:  '); readln(opcao);
    
    case opcao of
     
     1: begin 
         writeln ('     você escolheu a opção 1.  ');
         writeln;
         write('digite o elemento a ser digitado: ');readln(c.Chave);
         inserir(c,elemento);
        end;
         
     2: begin
          writeln ('     você escolheu a opção 2.  ');
          writeln;
          Shellsort(elemento);
          imprimir(elemento);
         end;
         
     3: begin
          writeln ('     você escolheu a opção 3.  ');
          writeln;
          FazListaVazia(elemento);
         end;
             
     4: writeln ('     você escolheu a opção 4.  ');   
     else writeln (' você digitou uma opção invalida.  ');
    end;
  writeln;
  writeln('Digite qualquer tecla para continuar .....');
  readkey;
until (opcao = 4);
end.

Simon Viegas · 24 de julho de 2016

Certo... a primeira coisa a fazer é testar se armazenando corretamente. Um maneira simples de fazer isso é "imprimir" sem ordenar...

Após confirmar isso, obviamente, o erro estará no ShellSort! Ai terá que dá uma revisada nele...

No aguardo.

Anderson Eiji · 24 de julho de 2016

@Simon Viegas , tive que arrumar o Shellsort mesmo, colocando um -1, porém agora a opção 2 desse programa em baixo não está pegando, e preciso entregar amanhã,

Program Shellsort_LISTA_ENCADEADA_ARRANJO;
const
    inicioArranjo = 1;
         MaxTam = 255;
type
     Apontador = integer;
     TipoItem = record
           Chave: string;
               end;
      indice = 1..MaxTam;
    TipoLista = record
            item: array [indice] of TipoItem;
						Primeiro: Apontador;
						Ultimo: Apontador;
				end;
				
var
 elemento: TipoLista;			
 opcao: integer;
     c:TipoItem; 

procedure inserir(x:TipoItem; var elemento:TipoLista);
begin
   if (elemento.Ultimo > MaxTam)
      then  writeln ('O programa tem capacidade máxima de 255 caracteres!')
			else 
			  begin
			     elemento.Item[elemento.Ultimo]:=x; 
			     elemento.Ultimo:=elemento.Ultimo + 1;
			  end;
end;

procedure inserir2(var elemento: TipoLista);  //arrumar, pois não está mostrando para imprimir
var i,k:integer; x:TipoItem;
begin
writeln('  digite uma quantidade de elementos, sendo menor que 255.');
write('    quantos elementos serão digitados?: ');readln(k);
if (k > 255)
  then
     while (k > 255) do
       begin
          writeln('  digite uma quantidade de elementos, sendo menor que 255.');
 	        write('quantos elementos serão digitados: ');readln(k);     	      
       end;		 	   
writeln;
for i:=elemento.Ultimo to k do
   begin
      write('digite o elemento a ser ordenado e tecle <ENTER>: ');readln(x.Chave);
			elemento.Item[i]:=x;       
	 end;		      
end;

procedure FazListaVazia(var elemento: TipoLista);
begin
	 elemento.Primeiro:=inicioArranjo;
	 elemento.Ultimo:=elemento.Primeiro;
	 writeln;
	 writeln('        vetor dos elementos zerado com sucesso!');
end;

function Vazia(var elemento:TipoLista):boolean;
begin
  Vazia:=elemento.Primeiro=elemento.Ultimo;
end;				 
			  
procedure ShellSort(var elemento:TipoLista);
var i, j: Indice;
       h: integer;
       x: TipoItem;
begin
  gotoxy(11, 24); writeln('Aguarde... Ordenando - ShellSort !');
  h := 1;
  repeat h := 3 * h + 1 until h > elemento.Ultimo - 1; //coloquei um -1 aqui, tava elemento.Ultimo
  repeat
    h := h div 3;
    for i := h + 1 to elemento.Ultimo - 1 do
    begin
      x.Chave := elemento.item[i].Chave; //normal é só x;
      j := i;
      while (j > h) and (elemento.item[j - h].Chave > x.Chave) do
      begin
        elemento.item[j] := elemento.item[j - h];
           j := j - h;
      end;
      elemento.item[j] := x;
    end;
  until h = 1;
  gotoxy(11, 24); writeln('Atencao.... Ordenacao Concluida !');
 end;

procedure Parada;
var Tecla: char;
begin 
  gotoxy(60, 25); write('Pressione algo !');
  Tecla := readkey;
end;


procedure imprimir(var elemento: TipoLista);
var Nl, Nc: byte;
         i: Indice;
begin
  clrscr;
  gotoxy(01, 24); writeln('Mensagem: Aguarde... Exibe Elementos !');
  Nl := 1;
  Nc := 1;
  for i:= elemento.Primeiro to (elemento.Ultimo-1) do 
  begin
    gotoxy(Nc, Nl); write(i:5,'- ',elemento.Item[i].Chave);
    Nl := Nl + 1;
    if   Nl = 22
         then begin
                Nl := 1;
                Nc := Nc + 15;
                if   Nc > 65
                     then begin
                            Parada;
                            clrscr;
                            gotoxy(01, 24); writeln('Mensagem: Aguarde... Exibe Elementos !');
                            Nc := 1;
                          end;
              end;
  end;
  gotoxy(11, 24); writeln('Atencao... Exibicao Concluida !');
end;

//  programa principal
Begin
FazListaVazia(elemento);
//elemento.Ultimo:=1;
  repeat
    clrscr;  //limpa a tela 
    writeln('(1) digitar um valor para o elemento.');
    writeln('(2) digitar o elemento inteiro a cada ENTER e sabendo da quantidade do elemento.');
    writeln('(3) imprimir elemento não ordenado.');
    writeln('(4) imprimir elemento ordenado por Shellsort.');
    writeln('(5) zerar a lista de elementos.');
		writeln('(6) sair do programa.');  
Writeln; //imprime uma linha em branco    
    write(' digite a opção desejada:  '); readln(opcao);
    
    case opcao of
     
     1: begin 
         writeln ('     você escolheu a opção 1.  ');
         writeln;
         write('digite um valor: ');readln(c.Chave);
         inserir(c,elemento);
        end;

     2: begin
          writeln ('     você escolheu a opção 2.  ');
          writeln;
          inserir2(elemento);
         end;

     3: begin
          writeln ('     você escolheu a opção 3.  ');
          writeln;
          imprimir(elemento);
         end;
         
     4: begin
          writeln ('     você escolheu a opção 4.  ');
          writeln;
          Shellsort(elemento);
          imprimir(elemento);
         end;
         
     5: begin
          writeln ('     você escolheu a opção 5.  ');
          writeln;
          FazListaVazia(elemento);
         end;
             
     6: writeln ('     você escolheu a opção 6.  ');   
     else writeln (' você digitou uma opção invalida.  ');
    end;
  writeln;
  writeln('Digite qualquer tecla para continuar .....');
  readkey;
until (opcao = 6);
end.

Simon Viegas · 24 de julho de 2016

Olá.

Explicação no trecho abaixo...:

procedure inserir2(var elemento: TipoLista);  //arrumar, pois não está mostrando para imprimir
  var
    i,k: integer;
    x  : TipoItem;
  begin
  writeln('  digite uma quantidade de elementos, sendo menor que 255.'); //tem que ser menor do que o sobrou!!! [Simon.Viegas]
  write  ('    quantos elementos serão digitados?: '); readln(k);
  if (k > 255) then //maior que o que sobrou [Simon.Viegas]
  while (k > 255) do //idem  obs.: não precisa do if acima, o while já faz esse papel!  (a não ser que precisa do else) [Simon.Viegas]
    begin
    writeln('  digite uma quantidade de elementos, sendo menor que 255.');
    write('quantos elementos serão digitados: ');readln(k);     	      
    end;
  writeln;
  for i:=elemento.Ultimo to k do
    begin
    write('digite o elemento a ser ordenado e tecle <ENTER>: '); readln(x.Chave);
    elemento.Item[i]:=x; //seria necessário ir atualizando o último!!! mas seria melhor chamar o "inserir()". [Simon.Viegas]
    end;		      
  end;

Observações em relação ao código em si.

1) O "elemento.Ultimo" não armazena o valor total de elementos, mas sim a posição do último elemento (no contexto apontando para próximo após o último). Para saber o total, teria que fazer uma contata entre o primeiro e a última posição! Creio que usar essa variável para esse fim (total), seria um erro!

Daí, seria necessário também ajustar os trechos que usam esse informação (total de elementos).

2) Pelo que eu vi da sua lista, ela não é "encadeada", pois não existe (não identifiquei) encadeamento algum nela! Os "apontadores" estão apontando simplesmente para o início e fim da lista. O encadeamento seria se cada posição apontasse para o seu sucesso (encadeamento simples) ou para o seu sucessor e antecessor (duplamente encadeada), de forma que para acessar, por exemplo, a 4 posição, teria que acessar a primeira posição, que possua vez apontaria para a segunda, que apontaria para 3ª, que finalmente apontando para 4ª... (ou vindo da última, se for duplamente encadeada). Me corrijam se estou equivocado em algum ponto!

3) Antes de imprimir, seria necessário verificar se está vazio, inclusive você já implementou a função para isso..

4) É necessário fazer alguns ajustes em relação ao total de posições disponíveis. Sugiro que diminua o MaxTam para um número menor, como 3! Ai faz o testes e vai ajustando!

Por ai vai.

***

No aguardo.

Anderson Eiji · 24 de julho de 2016

@Simon Viegas , deu certo aqui, muito obrigado!! Mas deve ter algumas coisas a melhorar que não sei..

Program Shellsort_Lista_Linear_Por_Arranjo;
const
    inicioArranjo = 1;
         MaxTam = 255;
type
     Apontador = integer;
     TipoItem = record
           Chave: string;
               end;
      indice = 1..MaxTam;
    TipoLista = record
            item: array [indice] of TipoItem;
						Primeiro: Apontador;
						Ultimo: Apontador;
				end;
				
var
 elemento: TipoLista;			
 opcao: integer;
     c:TipoItem; 

procedure inserir(var elemento: TipoLista);
var i,k,s:Apontador;
begin
if (MaxTam-(elemento.Ultimo-1) = MaxTam)
 then
   begin
       writeln('  digite uma quantidade de elementos, sendo menor ou igual que ',MaxTam,'.');
       write('    quantos elementos serão digitados?: ');readln(k);
       while (k > MaxTam) do
       begin
          writeln('  digite uma quantidade de elementos, sendo menor ou igual que ', MaxTam,'.');
 	        write('quantos elementos serão digitados: ');readln(k);     	      
       end;
			 if (k = 0) 
			    then
					  begin
						  writeln; 
					    writeln (' nenhum valor será digitado!');
					  end  
					else 
					  begin 		 	   
               writeln;
               for i:=elemento.Ultimo to k do 
                begin
                  write('digite um valor do elemento e tecle <ENTER>: ');readln(c.Chave);
	 		            elemento.Item[elemento.Ultimo]:=c; 
	 		            elemento.Ultimo:=elemento.Ultimo + 1;       
	              end;
						end;			
	 end
	else 
	  begin
	     s:=MaxTam-(elemento.Ultimo-1);
	     writeln('  digite uma quantidade de elementos, sendo menor ou igual que ',s,'.');
       write('    quantos elementos serão digitados?: ');readln(k);
       while ((k + s) > MaxTam) do
       begin
          writeln('  digite uma quantidade de elementos, sendo menor ou igual que ',s,'.');
 	        write('quantos elementos serão digitados: ');readln(k);     	      
       end;		 	   
       writeln;
			 if (k = 0) 
			    then
			      begin
					    writeln; 
					    writeln ('      nenhum valor será digitado!');
					  end  
					else 
					  begin
						  writeln;       
              for i:=elemento.Ultimo to (k + s) do 
               begin
                write('digite um valor do elemento e tecle <ENTER>: ');readln(c.Chave);
			          elemento.Item[elemento.Ultimo]:=c; 
			          elemento.Ultimo:=elemento.Ultimo + 1;       
	             end;
						end;			      
		end;		      
end;

procedure inserir2(x:TipoItem; var elemento:TipoLista);
begin
	 elemento.Item[elemento.Ultimo]:=x; 
	elemento.Ultimo:=elemento.Ultimo + 1;
end;

procedure FazListaVazia(var elemento: TipoLista);
begin
	 elemento.Primeiro:=inicioArranjo;
	 elemento.Ultimo:=elemento.Primeiro;
	 writeln;
	 writeln('        lista zerada com sucesso!');
end;

function Vazia(var elemento:TipoLista):boolean;
begin
  Vazia:=elemento.Primeiro=elemento.Ultimo;
end;				 
			  
procedure ShellSort(var elemento:TipoLista);
var i, j: Indice;
       h: integer;
       x: TipoItem;
begin
  gotoxy(11, 24); writeln('Aguarde... Ordenando - ShellSort !');
  h := 1;
  repeat h := 3 * h + 1 until h > elemento.Ultimo - 1;
  repeat
    h := h div 3;
    for i := h + 1 to elemento.Ultimo - 1 do
    begin
      x.Chave := elemento.item[i].Chave;
      j := i;
      while (j > h) and (elemento.item[j - h].Chave > x.Chave) do
      begin
        elemento.item[j] := elemento.item[j - h];
        j := j - h;
      end;
      elemento.item[j] := x;
    end;
  until h = 1;
  gotoxy(11, 24); writeln('Atencao.... Ordenacao Concluida !');
 end;

procedure Parada;
var Tecla: char;
begin 
  gotoxy(60, 25); write('Pressione algo !');
  Tecla := readkey;
end;


procedure imprimir(var elemento: TipoLista);
var Nl, Nc: byte;
         i: Indice;
begin
  if (Vazia(elemento)=true)
    then writeln ('    Nenhum valor foi digitado!')
    else
      begin
         clrscr;
         gotoxy(01, 24); writeln('Mensagem: Aguarde... Exibe Elementos !');
         Nl := 1;
         Nc := 1;
         for i:= elemento.Primeiro to (elemento.Ultimo-1) do 
           begin
             gotoxy(Nc, Nl); write(i:5,'- ',elemento.Item[i].Chave);
             Nl := Nl + 1;
             if   Nl = 22
                then begin
                        Nl := 1;
                        Nc := Nc + 15;
                        if   Nc > 65
                        then begin
                               Parada;
                               clrscr;
                               gotoxy(01, 24); writeln('Mensagem: Aguarde... Exibe Elementos !');
                               Nc := 1;
                             end;
                     end;
           end;
         gotoxy(11, 24); writeln('Atencao... Exibicao Concluida !');
      end;    
end;

procedure inserir2_;
begin
    if (elemento.Ultimo > MaxTam)
      then
			 begin  
			   writeln ('    O programa tem capacidade máxima de ',MaxTam,' caracteres!');
			   writeln('  Restam mais ',MaxTam-(elemento.Ultimo-1),' caracteres.');
			 end  
			else
			begin 
    write('digite um valor: ');readln(c.Chave);
    inserir2(c,elemento);
    writeln;
		writeln('  Restam mais ',MaxTam-(elemento.Ultimo-1),' caracteres.');
		  end;
end;

//  programa principal
Begin
FazListaVazia(elemento);
  repeat
    clrscr;  //limpa a tela 
    writeln('(1) digitar o elemento inteiro a cada ENTER e sabendo da quantidade do elemento.');
    writeln('(2) digitar um valor do elemento sem saber a quantidade a ser digitada.');
    writeln('(3) imprimir elemento não ordenado.');
    writeln('(4) imprimir elemento ordenado por Shellsort.');
    writeln('(5) zerar a lista de elementos.');
		writeln('(6) sair do programa.');  
Writeln; //imprime uma linha em branco    
    write(' digite a opção desejada:  '); readln(opcao);
    
    case opcao of
     
     1: begin 
         writeln ('     você escolheu a opção 1.  ');
         writeln;
         inserir(elemento);
        end;

     2: begin
          writeln ('     você escolheu a opção 2.  ');
          writeln;
          inserir2_;
         end;

     3: begin
          writeln ('     você escolheu a opção 3.  ');
          writeln;
          imprimir(elemento);
         end;
         
     4: begin
          writeln ('     você escolheu a opção 4.  ');
          writeln;
          Shellsort(elemento);
          imprimir(elemento);
         end;
         
     5: begin
          writeln ('     você escolheu a opção 5.  ');
          writeln;
          FazListaVazia(elemento);
         end;
             
     6: writeln ('     você escolheu a opção 6.  ');   
     else writeln (' você digitou uma opção invalida.  ');
    end;
  writeln;
  writeln('Digite qualquer tecla para continuar .....');
  readkey;
until (opcao = 6);
end.

Anderson Eiji · 25 de julho de 2016

@Simon Viegas , uma pergunta se eu for fazer por lista através de apontador (ponteiro), mudaria a complexidade do procedimento Shellsort, ne? Uma vez que precisaria um laço de repetição para percorrer a lista e encontrar tal posição... porque por lista através de apontador (lista encadeada) só é possível acessar a posição sequencialmente, certo?

Simon Viegas · 25 de julho de 2016

7 minutos atrás, Anderson Eiji disse:

@Simon Viegas , uma pergunta se eu for fazer por lista através de apontador (ponteiro), mudaria a complexidade do procedimento Shellsort, ne? Uma vez que precisaria um laço de repetição para percorrer a lista e encontrar tal posição... porque por lista através de apontador (lista encadeada) só é possível acessar a posição sequencialmente, certo?

@Anderson Eiji, em tese sim. Não sei dizer se ficaria "mais pesado" ou não para rodar (acho que na prática a diferença é imperceptível), mas seria de fato mais passos a serem executados pelo código, ou seja, não necessariamente mais passados pelos processador, pois o array em si também tem a sua complexidade, a diferença é que é pronta e transparente!!

Para acessar as posições poderia usar uma function... algo como...

funtion retornaPosicao(pos:integer; elemento:^Apontador):^Apontador;

Obs.: não sei dizer se funciona com ponteiros diretamente assim (sem usar um type) ou mesmo se funciona com ponteiros... mas seria algo assim.

Simon Viegas · 25 de julho de 2016

O seu programa não está funcionado aqui... não está imprimindo corretamente...

Abaixo algumas dicas/sugestões:

1) Dá para simplificar o processo de cadastrar mais de um. Apenas precisa saber quantos quer cadastrar e se tem espaço suficiente. E vai adicionado pelo inserir(). obs.: Não faz diferença se não tem nenhum cadastrado ou não.

Ex.: Quero adicionar 5. Leio o valor e adiciono pelo inserir() cinco vezes. FIM.

procedure inserir(x:TipoItem; var elemento:TipoLista);
  begin
  elemento.Item[elemento.Ultimo]:=x;
  elemento.Ultimo:=elemento.Ultimo+1;
  end;

Obs.: Seria bom colocar uma verificação se tem espaço ou não dentro do inserir.

2) Você precisa calcular o total de elementos cadastrados, o elemento.ultimo NÃO CONTÉM o total de elementos! Para calcular, teria que fazer a conta da quantidade de posições entre .Primeiro e .Ultimo. Obs.: no seu caso, o .Ultimo (-1) corresponde ao total, mas seria considerado um erro de lógica!!! (veja item 3!)

3) Pelo fato de está utilizando .Primeiro e .Ultimo sugere que essa lista é seria uma FILA, ou seja, que utiliza o conceito de FIFO (já que necessariamente só mudaria o valor do "primeiro" e do "último", sempre tendo preenchido os valores entre eles) Mas não está utilizando a parte da remoção (saindo da fila), logo sendo uma simples lista mesmo... Daí, para corrigir, seria melhor tirar a variável .Primeiro (que não está sendo usado pra nada) e alterar o .Ultimo para .Total !!! Assim fica correto...E a variável passaria ter de fato o total (-1).

Obs.: Não pode ser uma PILHA, pois nela o ".primeiro" não se altera!! O máximo que poderia ocorrer é misturar os conceito, como "pode sair pelo início, ou pelo fim.. veja, no conceito de LISTA em si, não existe essa limitação de sair de um lado ou de outro!!! pode sair de qualquer lugar, entende? Só as FILAS, e as PILHAS, que tem suas respectivas características "fixas" (se não usar, deixa de ser... tipo, se tem uma FILA, e sai alguém do meio, não é mais fila!!! Sacou?).

***

Tem outros pontos, mas sugiro que tente corrigir esses. A depender iríamos vendo mais!

No aguardo.

Anderson Eiji · 26 de julho de 2016

Na verdade tava fazendo errado, porque o enunciado do professor é esse:

Escreva um programa em Pascal, utilizando o algoritmo de classificação sorteado
para sua equipe (no caso Shellsort), que receba como entrada um frase escrita pelo usuário com até 255
caracteres (letras e/ou números). Cada caractere da frase deve ser armazenado
individualmente em uma unidade de um vetor ou lista (ponteiros). Seu programa deve
mostrar na tela o conjunto de entradas (letras e números da frase) em ordem
crescente de valores de acordo com a Tabela ASCII. Utilize o conceito de
programação modular (funções e procedimentos) para a criação do programa em
questão.
Obs.: Em Pascal a função chr(int) imprime na tela o caractere de valor int, entre 1 –
256.

Dai, refiz e o professor me ajudou. Ficou assim:

Program Shellsort;
const n = 255; 
type 
         vetor = array [0..n] of integer;
var     
        elemento: string;
    Opcao,i: integer;
        v:vetor;

        
procedure Parada;
var Tecla: char;
begin 
  gotoxy(60, 25); write('Pressione algo !');
  Tecla := readkey;
end;

procedure inserir(i:integer);
begin	 	   
writeln;
 write('digite o elemento a frase: ');readln(elemento);
for i:=1 to length(elemento) do
   begin
      v[i]:=ord(elemento[i]);
	 end;		      
end;

procedure imprimir_frase(var i:integer);
var Nl, Nc: byte;
begin
  clrscr;
  gotoxy(01, 24); writeln('Mensagem: Aguarde... Exibe Elementos !');
  Nl := 1;
  Nc := 1;
  for i := 1 to length(elemento) do
  begin
    gotoxy(Nc, Nl); write(elemento[i]:5,'- ',(ord(elemento[i])));
    Nl := Nl + 1;
    if   Nl = 22
         then begin
                Nl := 1;
                Nc := Nc + 15;
                if   Nc > 65
                     then begin
                            Parada;
                            clrscr;
                            gotoxy(01, 24); writeln('Mensagem: Aguarde... Exibe Elementos !');
                            Nc := 1;
                          end;
              end;
  end;
  gotoxy(11, 24); writeln('Atencao... Exibicao Concluida !');
end;
                                   
						      
procedure ShellSort;
var a, j: integer;
       h: integer;
       x: integer;
begin
  gotoxy(11, 24); writeln('Aguarde... Ordenando - ShellSort !');
  h := 1;
  repeat h := 3 * h + 1 until h > length(elemento);
  repeat
    h := h div 3;
    for a := h + 1 to length(elemento) do
    begin
      x := v[a];
      j := a;
      while (j > h) and (v[j - h] > x) do
      begin
        v[j] := v[j - h];
        j := j - h;
      end;
      v[j] := x;
    end;
  until h = 1;
  gotoxy(11, 24); writeln('Atencao.... Ordenacao Concluida !');
 end; 

procedure imprimir(var i:integer);
var Nl, Nc: byte;
begin
  clrscr;
  gotoxy(01, 24); writeln('Mensagem: Aguarde... Exibe Elementos !');
  Nl := 1;
  Nc := 1;
  for i := 1 to length(elemento) do
  begin
    gotoxy(Nc, Nl); write(i:5,'- ',(v[i])); // se quiser o número digitado inicialmente coloca chr(v[i]))
    Nl := Nl + 1;
    if   Nl = 22
         then begin
                Nl := 1;
                Nc := Nc + 15;
                if   Nc > 65
                     then begin
                            Parada;
                            clrscr;
                            gotoxy(01, 24); writeln('Mensagem: Aguarde... Exibe Elementos !');
                            Nc := 1;
                          end;
              end;
  end;
  gotoxy(11, 24); writeln('Atencao... Exibicao Concluida !');
end;

  
//  programa principal
Begin
  repeat
    clrscr;  //limpa a tela 
    writeln('(1) digitar o elemento inteiro.');
    writeln('(2) imprimir o elemento sem estar ordenado.');    
    writeln('(3) imprimir o elemento ordenado por Shellsort.');
    writeln('(4) sair do programa.');  
writeln; //imprime uma linha em branco    
    write(' digite a opção desejada:  '); readln(opcao);
    
    case opcao of
     
     1: begin 
         writeln ('     você escolheu a opção 1.  ');
         writeln;
         inserir(i);
        end;

     2: begin
          writeln ('     você escolheu a opção 2.  ');
          writeln;
          imprimir_frase(i);
         end;
         
     3: begin
          writeln ('     você escolheu a opção 3.  ');
          writeln;
          Shellsort;
          imprimir(i);
         end;
 			        
     4: writeln ('     você escolheu a opção 4.  ');   
     else writeln (' você digitou uma opção invalida.  ');
    end;
  writeln;
  writeln('               Digite qualquer tecla para continuar .....');
  readkey;
until (opcao = 4);    
end.

Simon Viegas · 26 de julho de 2016

Olá @Anderson Eiji.

1) Armazenando em inconformidade

10 horas atrás, Anderson Eiji disse:

Cada caractere da frase deve ser armazenado individualmente em uma unidade de um vetor ou lista (ponteiros).

10 horas atrás, Anderson Eiji disse:


procedure inserir(i:integer);
begin	 	   
writeln;
 write('digite o elemento a frase: ');readln(elemento);
for i:=1 to length(elemento) do
   begin
      v[i]:=ord(elemento[i]);
	 end;		      
end;

Ele está pedindo para armazenar os caracteres, não os códigos deles!

2) Resultado não exibindo como solicitado

10 horas atrás, Anderson Eiji disse:

Seu programa deve mostrar na tela o conjunto de entradas (letras e números da frase) em ordem crescente de valores de acordo com a Tabela ASCII.

Aqui não funcionou... tá exibindo apenas números, mas deveria exibir "os caracteres ordenados".

***

Pelo enunciado, o armazenamento e exibição dos caracteres são feitos normalmente... a Tablea ASCII entra na hora de ordenar, ou seja, "compara a ordem utilizando o código dos caracteres". (em vez de comparar a conteúdo da posição direto, compara o código do caractere)

No aguardo.