VPF::[Delphi] Исправление программного кода

I_Am_Rock

Дата 22.5.2009, 21:48 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 523
Регистрация: 18.1.2008

Репутация: 2
Всего: 15

Привет всем хорошим программистам (ну, и плохим тоже) smile

Вот код. На форме текстовое поле и две кнопки. Они работают (т.е. их код работает). Но я никак не могу использовать процедуру Sort. Помогите пожалуйста - добавьте ее правильным образом туда, где написано {!!!!!}. И скажите - процедура вообще правильная? - она делает сортировку линейного списка?

Надеюсь и жду!

Код


unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Edit1: TEdit;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
type
  TPSpisok=^TSpisok;
  TSpisok = record
  chislo:integer;  
  next: TPSpisok; 
  end;

var
  Form1: TForm1;
   head: TPSpisok;
implementation

uses TypInfo;

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
   curr: TPSpisok;
begin
   new(curr); //создание нового элемента списка
   curr^.chislo:=strtoint(Edit1.Text);

   // добавление в начало списка
   curr^.next:=head;
   head:=curr;
   Edit1.text:='';
end;

procedure TForm1.Button2Click(Sender: TObject);
var
 curr: TPSpisok;
 n:integer; 
 st:string; 
begin
 n:=0;
 st:='';
 curr:=head;
 while curr <> NIL do
    begin
      n:=n+1;
      st:=st+inttostr(curr^.chislo)+#13;
      curr:=curr^.next;
    end;
 if n <> 0
    then ShowMessage('Список:'+#13+st)
    else ShowMessage('В списке нет элементов.');

    {!!!!!}

end;


Procedure Sort(P: TPSpisok);
Var F,F1:TPSpisok;
Sorted:Boolean;

Begin
  Sorted:=False;
  While Sorted Do Begin
    Sorted:=True;
        F:=P;
    While (F<>nil)and(F^.next<>nil) Do Begin
        F1:=F;
         F:=F^.next;
        If F^.chislo>F1^.chislo Then Begin
        F1^.next:=F^.next;
        F^.next:=f1;
        If p=F1 Then P:=F;
        F:=F^.next;
        Sorted:=False;
        End;
    End;
  End;
End;

end.

Это сообщение отредактировал(а) I_Am_Rock - 22.5.2009, 21:51

mr.Anderson

Дата 22.5.2009, 22:10 (ссылка)

(нет голосов)

Загрузка ...

iOS Lead Developer

Профиль
Группа: Участник Клуба
Сообщений: 3374
Регистрация: 20.12.2004
Где: далеко

Репутация: 16
Всего: 128

Ее в указанном месте получится использовать только в том случае, если ты объявишь и определишь ее перед функцией Button2Click. Иначе компилер ругаться будет. Насчет сортировки - алгоритм не глядел, но сразу могу сказать, что у тебя она выполняться не будет, т.к. ты сначала впихиваешь в Sorted значение False, а потом запускаешь цикл while sorted, он не выполнится ни разу, поскольку sorted уже ложно.

--------------------

I_Am_Rock

Дата 22.5.2009, 22:20 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 523
Регистрация: 18.1.2008

Репутация: 2
Всего: 15

Цитата(mr.Anderson @ 22.5.2009, 22:10

)

Ее в указанном месте получится использовать только в том случае, если ты объявишь и определишь ее перед функцией Button2Click. Иначе компилер ругаться будет.

Ааа. Вот оно че! smile

Не знал я такую тонкость. Спасибо. smile

А алгоритм Sort - таким я его нашел. Попытаюсь починить. smile

Если мне кто-нибудь поможет, буду очень-очень благодарен.

mr.Anderson

Дата 22.5.2009, 22:50 (ссылка)

(нет голосов)

Загрузка ...

iOS Lead Developer

Профиль
Группа: Участник Клуба
Сообщений: 3374
Регистрация: 20.12.2004
Где: далеко

Репутация: 16
Всего: 128

I_Am_Rock, не стал вникать в описанный алг, если он так начинается, то явно нерабочий)))

Попробуй использовать один из известных алгоритмов, тот же пузырек хотя бы для простоты. Хотя я больше использую сортировку выбором, но в случае списка не пробовал реализовывать. Сейчас попробую, если что получится - отпишусь.

Добавлено через 1 минуту и 42 секунды
Кстати, насчет "тонкости" - функция либо должна быть объявлена до момента использования, либо быть членом класса, как Button1/2Click. Вообще, по-хорошему, второе предпочтительней.

--------------------

mr.Anderson

Дата 22.5.2009, 23:26 (ссылка)

(нет голосов)

Загрузка ...

iOS Lead Developer

Профиль
Группа: Участник Клуба
Сообщений: 3374
Регистрация: 20.12.2004
Где: далеко

Репутация: 16
Всего: 128

Так и быть. Ваяю полный пример по работе с односвязным списком, включая сортировку, со всеми комментариями и объяснениями. Как закончу - выложу.

--------------------

I_Am_Rock

Дата 22.5.2009, 23:38 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 523
Регистрация: 18.1.2008

Репутация: 2
Всего: 15

Цитата(mr.Anderson @ 22.5.2009, 23:26

)

Большое спасибо! smile

mr.Anderson

Дата 23.5.2009, 00:38 (ссылка)

(нет голосов)

Загрузка ...

iOS Lead Developer

Профиль
Группа: Участник Клуба
Сообщений: 3374
Регистрация: 20.12.2004
Где: далеко

Репутация: 16
Всего: 128

Мда... сильно голова болит, очень мало сплю последнее время, и вставать рано... поэтому не успел написать до конца. То, что написано, кроме сортировки, проверено и работает. Сортировку не проверял. Осталось дописать обмен элементов местами, там надо похимичить с переадресацией ссылок, я сейчас уже плохо соображаю. Попробуй сам прописать функцию SwapList в коде, если сможешь - поздравляю, код должен работать, если нет - я попробую завтра найти время и дописать это.

То, что наработано на текущий момент, со всеми пояснениями.

Код


program List;

{$APPTYPE CONSOLE}

uses
  SysUtils;

type
  PList =^TList;
  TList = record
    Val: Integer;
    pNext: PList;
  end;

var
  pFirst: PList; //указатель на первый элемент
  pLast: PList; //указатель на последний элемент (нам будет удобно с ним)
  Count: Integer; //количество элементов в списке (тоже пригодится)

function Find(N: Integer; FindStrict: Boolean): PList;
var
  pCur: PList;
  C: Integer;
begin
  pCur := pFirst; //запоминаем текущий как первый
  Result := pCur; //его же запихиваем в результат на случай поиска 1 элемента
  C := 1; //счетчик
  while (C <= N) and (pCur <> nil) do //пока не дошли до запрошенного и он не нулевой
  begin
    Result := pCur; //переприсваиваем результат
    pCur := pCur.pNext; //переходим к следующему
    Inc(C); //увеличиваем счетчик
  end;

  //после отработки цикла выше мы получим последний элемент списка, если даже его номер не равен N.
  //для этого случая и есть второй параметр. Если он = True, то в случае несовпадения C и N
  //(то есть если найден неверный элемент, не тот, какой хотели) - результат станет nil.
  if FindStrict then
    if (N <= 0) or (C < N) then
      Result := nil;
end;

procedure Add(Val: Integer);
var
  List: PList;
begin
  Inc(Count); //говорим, что элементов стало на 1 больше
  New(List); //выделяем память
  List.Val := Val; //присваиваем значение
  List.pNext := nil; //следующий не будет указывать никуда

  if Assigned(pLast) then //если последний элемент в списке есть
  begin
    pLast.pNext := List; //то его следующим будет только что созданный
    pLast := List; //и только что созданный станет последним
  end;

  if not Assigned(pFirst) then //если также не присвоен первый элемент (т.е. создаем первый)
  begin
    pFirst := List; //присваиваем первый
    pLast := List; //одновременно и последний
  end;
end;

procedure Del(N: Integer);
var
  List: PList;
  Prev: PList;
begin
  List := Find(N, True); //ищем запрошенный строго по переданному номеру
  if Assigned(List) then //если что-то нашли, работаем
  begin
    Prev := nil; //попробуем найти предыдущий
    if (N-1) > 0 then //если его номер вообще >0
      Prev := Find(N-1, True); //ищем

    if Assigned(Prev) then //если нашли - здорово
    begin
      Prev.pNext := nil; //говорим, что его следующий больше не существует
      pLast := Prev; //и ставим его как последний
    end
    else //не нашли предыдущего
    begin
      if pLast = pFirst then //если элемент в списке один
        pFirst := nil; //зануляем первый
      pLast := nil; //попутно зануляем последний
    end;

    Dispose(List); //высвобождаем память
    Dec(Count); //говорим, что элементов стало на 1 меньше
  end;
end;

procedure Show(N: Integer); overload; //покажет элемент по номеру
var
  List: PList;
begin
  List := Find(N, True); //все довольно просто, ищем нужный элемент
  if Assigned(List) then
    WriteLn('Value: ', List.Val) //и выводим его
  else //если ж не найдем - выводим, что не нашли
    WriteLn('Not found');
end;

procedure Show(P: PList); overload; //покажет переданный элемент
begin
  WriteLn('Value: ', P.Val);
end;

procedure ShowAll;
var
  List: PList;
begin
  List := pFirst; //текущим элементом сначала будет первый
  while Assigned(List) do //пока наш элемент существует
  begin
    Show(List); //показываем его
    List := List.pNext; //переходим к следующему
  end;
end;

procedure SwapList(P1, P2: PList); //меняет элементы местами
begin
  //попробуй сам прописать
end;

procedure Sort; //сортирует выбором
var
  pMin: PList;
  pCur: PList;
  C, I: Integer;
begin
  //алгоритм сортировки выбором работает достаточно быстро и прост в реализации,
  //поэтому я его использую повсеместно, где не особо критична скорость.
  //состоит он в следующем: берется некая стартовая позиция (изначально первая). Выбирается
  //минимальный элемент, изначально он считается как элемент в выбранной позиции. После
  //этого запускается цикл от выбранной позиции +1 до конца массива, ищется новый минимальный.
  //Если он найден - здорово, меняем его с изначально выбранным местами, и увеличиваем
  //текущую позицию. Соответственно, следующий цикл уже будет сдвинут на 1 элемент вправо, и
  //так работаем, пока не отсортируем весь массив. Реализация сказанного ниже.
  C := 1;
  while C < (Count -1) do
  begin
    pMin := Find(C, True);
    for I := C+1 to Count do
    begin
      pCur := Find(I, True);
      if pCur.Val < pMin.Val then
      begin
        SwapList(pMin, pCur);
        break;
      end;
    end;

    Inc(C);
  end;
end;

begin
  pFirst := nil; //пока элементов в списке нет
  Add(52); //добавим элементик
  Show(1); //выведем его
  Del(1); //удалим
  Show(1); //снова попробуем вывести
  Del(1); //почистим

  //опробуем сортировку
  Add(23);
  Add(100);
  Add(1);
  Add(8);
  ShowAll; //покажем список
  Sort(); //отсортируем
  ShowAll; //снова покажем
  //сделаем задержку
  Readln;
end.

--------------------

I_Am_Rock

Дата 23.5.2009, 12:00 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 523
Регистрация: 18.1.2008

Репутация: 2
Всего: 15

Спасибо!

Только, к сожалению, мне нужен не консольный проект, а оконный. (
Буду пытаться адаптировать твой код сортировки под тот проект - там же сортировка не работает, но добавление и удаление норм.

А SwapList - ее задача просто менять местами pMin и pCur в процедуре Sort?

Код


procedure SwapList(P1, P2: PList); //меняет элементы местами
var
  pBuf: PList;
begin
  //попробуй сам прописать

  //пробую ))
  pBuf.val := P1.val;
  P1.val := P2.Val;
  P2.Val := pBuf.val;
end;

Правильно? smile

Добавлено через 9 минут и 32 секунды

Цитата(I_Am_Rock @ 23.5.2009, 12:00

)

но добавление и удаление норм.

О, я ошибся - не удаление, а отображение всего списка.

mr.Anderson

Дата 23.5.2009, 14:12 (ссылка)

(нет голосов)

Загрузка ...

iOS Lead Developer

Профиль
Группа: Участник Клуба
Сообщений: 3374
Регистрация: 20.12.2004
Где: далеко

Репутация: 16
Всего: 128

I_Am_Rock, не, неправильно. Я сам еще путаюсь постоянно. Смотри.

Если есть список

Эл1 -> Эл2 -> Эл3 -> Эл4 -> Эл5

и тебе надо поменять местами Эл2 и Эл4. Если ты просто поменяешь местами указатели, то это будет неверно, потому что ссылки на обменянные элементы окажутся неверными. По идее. Хотя попробуй. Я просто сейчас занят своей курсовой, поэтому нет толком времени дописать это.

--------------------

mr.Anderson

Дата 23.5.2009, 16:19 (ссылка)

(нет голосов)

Загрузка ...

iOS Lead Developer

Профиль
Группа: Участник Клуба
Сообщений: 3374
Регистрация: 20.12.2004
Где: далеко

Репутация: 16
Всего: 128

Ща глянул на код - процедуру сортировки неверно написал. Скорее, так:

Код


procedure Sort; //сортирует выбором
var
  pFirst: PList;
  pMin: PList;
  pCur: PList;
  C, I, Mem: Integer;
begin
  C := 1;
  while C < (Count -1) do
  begin
    Mem := C;
    pFirst := Find(C, True);
    pMin := pFirst;

    for I := C+1 to Count do
    begin
      pCur := Find(I, True);
      if pCur.Val < pMin.Val then
      begin
        pMin := pCur;
        Mem := I;
      end;
    end;

    if Mem <> C then
        SwapList(pFirst, pMin);

    Inc(C);
  end;
end;

--------------------

I_Am_Rock

Дата 23.5.2009, 17:12 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 523
Регистрация: 18.1.2008

Репутация: 2
Всего: 15

Цитата(mr.Anderson @ 23.5.2009, 14:12

)

и тебе надо поменять местами Эл2 и Эл4. Если ты просто поменяешь местами указатели, то это будет неверно, потому что ссылки на обменянные элементы окажутся неверными. По идее.

Точно. Я забыл, что здесь не как в массиве - что тут действительно нужно менять указатели на меняемые элементы. Но думаю, это вполне решаемо - нужно по очереди пройтись по всем элементам и когда указатель на следующий элемент будет равен меняемому, то отметить его. И с другим так же.
Буду пробовать. smile

I_Am_Rock

Дата 23.5.2009, 19:11 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 523
Регистрация: 18.1.2008

Репутация: 2
Всего: 15

Вот пробую (переделывая готовое-неправильное)

Код


procedure TForm1.Button6Click(Sender: TObject);
var sorted:Boolean;
nbuf, mbuf : TPSpisok;
begin
sorted:=False;
while sorted=False do begin
mbuf:=curr;
    while (mbuf<>nil) and (mbuf.next<>nil) do begin
     nbuf:=mbuf;
     mbuf:=mbuf.next;
      if mbuf.chislo > nbuf.chislo then begin
          nbuf.next:=mbuf.next;
          mbuf.next:=nbuf;
          if curr=nbuf then curr:=mbuf;
          mbuf:=mbuf.next;
          sorted:=False;
      end;
    end;
end;
end;

Почему-то ругается на второй while (((

mr.Anderson

Дата 23.5.2009, 19:19 (ссылка)

(нет голосов)

Загрузка ...

iOS Lead Developer

Профиль
Группа: Участник Клуба
Сообщений: 3374
Регистрация: 20.12.2004
Где: далеко

Репутация: 16
Всего: 128

Как ругается.

--------------------

I_Am_Rock

Дата 23.5.2009, 19:31 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 523
Регистрация: 18.1.2008

Репутация: 2
Всего: 15

Цитата(mr.Anderson @ 23.5.2009, 19:19

)

Как ругается.

Ой, я ошибся, в этом случае не ругается - зависает (при нажатии кнопки)!
Чтобы узнать где - жму Run -> Program Pause, затем жму раз за разом F7 и вижу, что текущая строчка "гуляет" здесь

Код


...
while sorted=False do begin
mbuf:=curr;
    while (mbuf<>nil) and (mbuf.next<>nil) do begin
...

т.е. доходит до 2-ого while и и возвращается к 1-ому. Пробовал и F8 - анагалогично. Не пойму - из-за чего?

Это сообщение отредактировал(а) I_Am_Rock - 23.5.2009, 19:32

mr.Anderson

Дата 23.5.2009, 19:33 (ссылка)

(нет голосов)

Загрузка ...

iOS Lead Developer

Профиль
Группа: Участник Клуба
Сообщений: 3374
Регистрация: 20.12.2004
Где: далеко

Репутация: 16
Всего: 128

I_Am_Rock, ааа. Так второй while просто никогда не выполняется, и все. Проверяй условие в нем.

--------------------

I_Am_Rock

Дата 23.5.2009, 19:41 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 523
Регистрация: 18.1.2008

Репутация: 2
Всего: 15

Точно! - не выполняется - потому что mbuf.next = nil.
Но я добавил строчку

Код


mbuf.next:=curr.next;

И он ругается (вот почему я сразу так написал!)

Цитата

Project Project1.exe raised exception class EAccessViolation with message 'Access violation at adress 0045C39 in module 'Project1.exe'/ Read of address 00000010'. Process stoped. Use Sttop or Run to continue.

((

mr.Anderson

Дата 23.5.2009, 20:03 (ссылка)

(нет голосов)

Загрузка ...

iOS Lead Developer

Профиль
Группа: Участник Клуба
Сообщений: 3374
Регистрация: 20.12.2004
Где: далеко

Репутация: 16
Всего: 128

Выданный Access Violation означает, что ты обращаешься в область памяти, которая тебе не принадлежит.

--------------------

I_Am_Rock

Дата 23.5.2009, 20:16 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 523
Регистрация: 18.1.2008

Репутация: 2
Всего: 15

Понятно.
Ну, я всю работу в принципе сделал - из того, что я написал в первом посте, я убрал совсем неправильную сортировку, зато - прикрутил удаление элемента, удаление списка, подсчет суммы и среднего значения, поиск макимума и минимума, а сам список отображается в ЛистБоксе и обновляется автоматически (если галочка поставлена). Т.е. все супер. Жаль только без сортировки будет. хотя, может, еще сделаю.
mr.Anderson, большое спасибо за помощь! Плюсанул репутацию. smile

mr.Anderson

Дата 23.5.2009, 20:23 (ссылка)

(нет голосов)

Загрузка ...

iOS Lead Developer

Профиль
Группа: Участник Клуба
Сообщений: 3374
Регистрация: 20.12.2004
Где: далеко

Репутация: 16
Всего: 128

I_Am_Rock, благодарю. smile

Заходи еще. smile

--------------------

I_Am_Rock

Дата 23.5.2009, 23:40 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 523
Регистрация: 18.1.2008

Репутация: 2
Всего: 15

Я все-таки решил еще чуть поделать сортировку и стал еще чуть ближе к решению.
Но вот такой вопрос.
Почему список "2 5 1" алгоритм сортирует правильно - "5 2 1", а "1 5 2" - неправильно ("5 1")?

Код


procedure TForm1.Button6Click(Sender: TObject);
var sorted:Boolean;
nbuf, mbuf : TPSpisok;
begin
sorted:=False;
curr:=head;
while sorted=False do begin
sorted:=True;
mbuf:=head;
mbuf.next:=head.next;
    while (mbuf<>nil) and (mbuf.next<>nil) do begin
     nbuf:=mbuf;
     mbuf:=mbuf.next;
      if mbuf.chislo > nbuf.chislo then begin
          nbuf.next:=mbuf.next;
          mbuf.next:=nbuf;
          if head=nbuf then head:=mbuf;
          mbuf:=mbuf.next;
          sorted:=False;
      end;
    end;
end;
end;

Уже всю голову сломал! (((

I_Am_Rock

Дата 24.5.2009, 16:11 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 523
Регистрация: 18.1.2008

Репутация: 2
Всего: 15

Все, сделал сортировку. smile

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Центр помощи \| Следующая тема »