IPB
ЛогинПароль:

> ВНИМАНИЕ!

Прежде чем задать вопрос, смотрите FAQ.
Рекомендуем загрузить DRKB.

 
 Ответить  Открыть новую тему 
> динамические структуры
:-)~
сообщение 25.05.2007 19:44
Сообщение #1


Новичок
*

Группа: Пользователи
Сообщений: 20
Пол: Мужской
Реальное имя: Дима

Репутация: -  0  +


помогите.... мне надо надо составить программу для упорядочивания в порядке возрастания элементов однонаправленного списка.
можно ли ее сделать так? если нет,то подскаите......запутался уже. wacko.gif

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}
type
  TPWord1=^TL;
  TL=record
    st:string[20];
    next:TPWord1; end;


    var
  head1:TPWord1;
  count,i,j:integer; curr:TPWord1; st:string;
   mass1:array[1..10]of byte;
   n,a:byte;

procedure TForm1.Button1Click(Sender: TObject);
begin
for i:=Memo1.Lines.Capacity downto 0 do
        begin
          inc(count);
          new(curr);
          curr^.st :=Memo1.Lines.Strings[i] ;
          curr^.next := head1;
          head1 := curr;
          end;
          Button1.Enabled:=false;
 a:=0;
 n:=0; curr:=head1;
 while n < count-1 do begin
    inc(n);
    mass1[n]:=strtoint(curr^.st);
    curr := curr^.next;
    end;
    for i:=1 to count-1 do
    for j:=1 to count-2 do
    if mass1[j]>mass1[j+1]
    then
    begin
    a:=mass1[j];
    mass1[j]:=mass1[j+1];
    mass1[j+1]:=a;

     end;
n:=0;
for i:=1 to count-1 do  begin
     new(curr);

      curr^.st :=inttostr(mass1[i]);
      curr^.next := head1;
      head1 := curr;
       end;


while n < count-1 do
  begin
 
  inc(n);
    st:=st+#13+curr^.st;
    curr := curr^.next;
  end;
if st='' then ShowMessage('Ñïèñîê ïóñò')
  else ShowMessage('Ðåçóëüòàò:'+st);

end;
end.


 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
мисс_граффити
сообщение 25.05.2007 20:05
Сообщение #2


просто человек
******

Группа: Модераторы
Сообщений: 3 641
Пол: Женский
Реальное имя: Юлия

Репутация: -  55  +


Со списками вот так:
    a:=mass1[j];
    mass1[j]:=mass1[j+1];
    mass1[j+1]:=a; 

не работают.
чтобы поменять элементы, меняют местами указатели на них...

посмотри вот здесь, например: http://forum.pascalnet.ru/lofiversion/index.php/t7992.html


--------------------
Все содержимое данного сообщения (кроме цитат) является моим личным скромным мнением и на статус истины в высшей инстанции не претендует.
На вопросы по программированию, физике, математике и т.д. в аське и личке не отвечаю. Даже "один-единственный раз" в виде исключения!
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
:-)~
сообщение 26.05.2007 10:42
Сообщение #3


Новичок
*

Группа: Пользователи
Сообщений: 20
Пол: Мужской
Реальное имя: Дима

Репутация: -  0  +


я попытался сделать примерно тоже, что и в примере который ты привела. Где ошибки?? Подскажи. mega_chok.gif

type
     plist=^node;
     node=record
     data: integer;
     next:plist;
     end;

     function insert_sort(l: plist): plist;
     function insert(a: plist; l: plist): plist;
       begin
       a^.next := nil;
         if l = nil then
         insert := a
         else
           if a^.data < l^.data then
           begin
           a^.next := l; insert := a;
           end
         else begin
           l^.next := insert(a, l^.next);
           insert := l;
           end;
         end;


            begin
           if l = nil then insert_sort := nil
           else insert_sort := insert(l, insert_sort(l^.next));
           end;

           Var
           first,sp1,head: plist;
           c: char;

               begin
           //Zapolnenie spiska
           new(first);
head:=first;
while true do
  begin
    write('chislo = ');
    readln(first^.data);
    write('eshe? y/n ');
    readln(c);
    if c = 'n' then
      begin
        first^.next:=nil;
        break;
      end
    else
      begin
        new(first^.next);
        first:=first^.next;
      end;
      sp1:=head;
      end;
      //VIZOV
           first := insert_sort(first);

           write(':::::',first^.data);
           readln;



end.


 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
volvo
сообщение 26.05.2007 13:11
Сообщение #4


Гость






Цитата
Где ошибки?
В заполнении списка:

type
  plist=^node;
  node=record
    data: integer;
    next:plist;
  end;

// insert_sort ...

Var
  first, last, p: plist;
  c: char;
  X: integer;

begin

  // Zapolnenie spiska
  
  c := 'y';
  while c <> 'n' do begin

    write('number = '); readln(X);
    new(p);
    p^.data := X; p^.next := nil;
  
    if first = nil then first := p
    else last^.next := p;
    last := p;
  
    write('more? [y/n]'); readln(c);
  
  end;

  //VIZOV
  first := insert_sort(first);

  p := first;
  while p <> nil do begin
    write(':::::', p^.data:6);
    p := p^.next;
  end;
  readln;
end.


P.S. В следующий раз большая просьба - не коверкай программу! Ты по ссылке нашел какой код? Отформатированный, так что сразу понятно, что за чем идет... Вот и выкладывай сюда так же отформатированный код!

Сообщение отредактировано: volvo - 26.05.2007 13:11
 К началу страницы 
+ Ответить 
:-)~
сообщение 26.05.2007 18:51
Сообщение #5


Новичок
*

Группа: Пользователи
Сообщений: 20
Пол: Мужской
Реальное имя: Дима

Репутация: -  0  +


там где
//insert_sort ...

надо вставлять функцию?
function insert_sort(l: plist): plist;
function insert(a: plist; l: plist): plist;
       begin
       a^.next := nil;
         if l = nil then
         insert := a
         else
           if a^.data < l^.data then
           begin
           a^.next := l; insert := a;
           end
         else begin
           l^.next := insert(a, l^.next);
           insert := l;
           end;
         end;


или как она должна выглядеть ??
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 

- Текстовая версия 29.07.2025 21:10
Хостинг предоставлен компанией "Веб Сервис Центр" при поддержке компании "ДокЛаб"