Версия для печати темы

Нажмите сюда для просмотра этой темы в обычном формате

Форум «Всё о Паскале» _ Задачи _ Нужна помощ с однонаправленным списком

Автор: Krjuger 12.05.2009 18:41

В общем задача заключается в том чтобы после елемента списока P1,с ключем Х,равным задаваемому значению А,вставить список P2.


Type
 TElem = string;      

 TList = ^TNode;      
 TNode = record       
	 Info: TElem;  
	 Next: TList   
	 end;
var
 P1,P2:TList;
 r:TList;
 A:integer;

Procedure Insert(var P1: Tlist; x : integer);
  begin
  new®;
  r^.info:=x;
  r^.next:=P1^.next;
  P1^.next:=r;
 end;


Тут я беру элемент из списка п2 и записываю его после элемента с ключем Х.В общем моя идея заключалась в том,чтобы создать процедуру,которая будет юзять insert и потихоньку выдирая из п2 по 1 элементу вставлять их каждый раз сдвигая ключ на 1,тем самым впихнуть весь список, но как это реализовать хз.

Так же есть вопрос немного в другой области.Необходимо взять из конца дека V элементов и вставить их в стек,вот тут приветствуются лбые идеи,потому что своих совсем нет(((
P.s.Просьба на фак не тыкать прочитал и не один,но если есть конкретные вещи из фака ,тобуду только рад.

Автор: volvo 12.05.2009 19:51

Цитата
В общем моя идея заключалась в том,чтобы создать процедуру,которая будет юзять insert и потихоньку выдирая из п2 по 1 элементу вставлять их каждый раз сдвигая ключ на 1,тем самым впихнуть весь список
Идея неправильная. Для того, чтобы сделать то, что надо, достаточно найти в первом списке элемент, который равен X (это просто, один цикл. В результате имеешь некий указатель P, такой, что P^.info = X), затем запомнить поле next этого элемента (оно нам еще пригодится), ну и:
P^.next := list_2; { <--- вставляешь список после P }
while p2^.next <> nil do p2 := p2^.next; { <--- ищешь конец второго списка }
p2^.next := saved_pointer; { <--- вот и понадобилось то, сохраненное значение }


Это все, что нужно... Чтобы понять как оно работает - начерти на бумаге 2 списка, и сделай то, что я посоветовал...

Автор: Krjuger 12.05.2009 21:49


Program laba9;
Type

 point = ^item;       
 item = record        
	 Number: integer; 
	 Next: point;  
 end;
var
 P1,P2: pointer;
 A:integer;

Procedure SeachAndInsert(P1,P2: point ; x : integer ; var q : point);
 var
  flag : boolean;
  save:Point;
 begin
  flag:=true;
  while (P1<>nil) and flag=true do
  begin
   if P1^.number=x then
    begin
    flag:=false;
    save^.next:=P1^.next;
    end
   else
    begin
     P1:=P1^.next;
    end;
  end;
   P1^.next:=P2;
   while P2^.next<> nil do
   P1:=P2^.next;
   P1^.next:=save^.next;
 end;


Ну вроде как то так получилось,но все равно не работает.



procedure BListPrint(var P1 : pointer );
begin
 write('< ');
 while P1 <> nil DO
 begin
  write( P1^.number );
  If P1^.Next <> nil then write(',');
  P1 := P1^.Next
 end;
 writeln(' >')
end;


Тут Invalid qualifier в строке write( P1^.number );хз че сделать.

Автор: volvo 12.05.2009 21:55

Цитата
Тут Invalid qualifier в строке
Абсолютно справедливо: нельзя разыменовывать Pointer. Чтобы обратиться куда-то через указатель, надо знать, на что этот указатель указывает (странно, правда?). А Pointer - указывает куда-то, а вот на что - неясно. Используй Point вместо Pointer, должно получиться...

Автор: Krjuger 12.05.2009 22:51

Тьфу ты, совсем с катушек сьезжаю,А насчет поиска и замены,что нить сказать можеш?

И еще там внизу я скинул так другую задачу,по сути мне надо создать дек,заполнить его чем либо,и проходя с конца,записывать в пустой стек,но если переносить их по мере прохода от конца до V в стеке они будут прямо или обратно выстроены?

И еще можно оценить такой вариант создания списка из файла.



function Chartoint(var j: char): integer ;
	begin
		case j of
			'1': Chartoint:=1;
			'2': Chartoint:=2;
			'3': Chartoint:=3;
			'4': Chartoint:=4;
			'5': Chartoint:=5;
			'6': Chartoint:=6;
			'7': Chartoint:=7;
			'8': Chartoint:=8;
			'9': Chartoint:=9;
			else Chartoint:=0;
		end;
	end;

Procedure Probel(var fin:text);
 begin
  if ch=' ' then
   begin
   read(fin,ch);
   Probel(fin);
   end;
 end;

Procedure Create(var p : point; var fin:text;);
 var
 k:integer;
 r:point;
 begin
  new®;
  reset(fin);
  while not eof(fin) do
  begin
  read(fin,ch);
  Probel(fin);
  while not (ch=' ') and (not eof(fin)) do
    begin
     p:=chartoint(ch);
     x:=x*10+k;
     read(fin,ch);
    end;
  r^.number:=x;
  p^.number:=r^.number;
  p^.next:=r^.next;
  x:=0;
  close(fin);
  end;
 end;


Автор: volvo 13.05.2009 0:17

Цитата
по сути мне надо создать дек,заполнить его чем либо,и проходя с конца,записывать в пустой стек
Реализации стека и дека свои приведи, потом будем разговаривать.

Цитата
Просьба на фак не тыкать прочитал и не один
Значит, перечитай более внимательно. Я не знаю, что и где ты читал, но у нас в FAQ-е есть то, что тебе нужно.

Цитата
можно оценить такой вариант создания списка из файла.
Лучше не оценивать. Ничего цензурного в голову не приходит. Что это у тебя за Chartoint ??? Это делается в одну строку:
Function CharToInt(ch: Char): Integer;
begin
  if Ch in ['1' .. '9'] then CharToInt := Ord(ch) - Ord('0') else CharToInt := 0;
end;

Зачем понадобилась рекурсивная процедура Probel? Что, программа слишком быстро работает и ошибки легко отлавливать? Хочешь усложнить этот процесс?

Ты б лучше задание точное привел, а не
Цитата
мне надо создать дек,заполнить его чем либо,и проходя с конца,записывать в пустой стек
Чем заполнить, что записывать, с какого конца проходить (дек - он позволяет проходить и с переднего и с заднего конца) - уточняй...

Автор: Krjuger 13.05.2009 0:27

"Взять из дека последние V элементов и записать их в стек".Вот такое вот задание,А сделать, как угодно.

Насчет рекурсивного пробела,уже привычка,с того момента,как синтаксический анализатор писал.Реализацию стека и дека чуть позже выыложу,а щас,пересмотрел идею с функцией char to int и пришел к такому варианту 

 
 uses CRT;
Type

 point = ^item;       {ЏаҐ¤бв ў«Ґ­ЁҐ бЇЁбЄ  }
 item = record        {‡ўҐ­® бЇЁбЄ }
	 Number: integer;
	 Next: point;   {‘«Ґ¤гойЁ© н«Ґ¬Ґ­в бЇЁбЄ }
	 end;
var
 P1,P2: point;
 A : integer;
 fin1,fin2 : text;

Procedure SeachAndInsert(P1,P2: point ; x : integer);
 var
  flag : boolean;
  save:Point;
 begin
  flag:=true;
  while (P1<>nil) and flag=true do
  begin
   if P1^.number=x then
    begin
    flag:=false;
    save^.next:=P1^.next;
    end
   else
    begin
     P1:=P1^.next;
    end;
  end;
   P1^.next:=P2;
   while P2^.next<> nil do
   P1:=P2^.next;
   P1^.next:=save^.next;
 end;


Procedure Create(var p : point; var fin:text);
 var
 r,m:point;
 begin
  new®;
  reset(fin);
  while not eof(fin) do
  begin
   new(m);
   read(fin,m^.number);
   m^.next:=nil;
   r^.next:=m;
   p:=m;
   write(p^.number);
   end;
   close(fin);
 end;


Procedure BListPrint( P : point );
begin
 write('< ');
 while P <> nil DO
 begin
  write( P^.number );
  If P^.Next <> nil then write(',');
  P := P^.Next
 end;
 writeln(' >')
end;

 begin
 clrscr;
 chdir('C:\Tpascal');
 assign(fin1,'test1.txt');
 assign(fin2,'test2.txt');
 Create(P1,fin1);
 BListPrint(P1);
 Create(P2,fin2);
 BListPrint(P2);
 writeln('‚ўҐ¤ЁвҐ Ї а ¬Ґва Ђ:');
 read(A);
 SeachAndInsert(P1,P2,A);
 BListPrint(P1);
 end.

Оба списка корректно заполняются,а вот вывод почему дает пустой вариант и еще добавление у меня не получилось проверить.

Автор: Krjuger 13.05.2009 18:00

Ну так кто нибуть может что нить дельное по этому поводу сказать?)

Автор: volvo 13.05.2009 18:30

Цитата
Ну так кто нибуть может что нить дельное по этому поводу сказать?)
Дельное? Пользуйся сам своими же советами:
Цитата(Krjuger @ 13.05.2009 12:16) *
И еще процедуры должны быть говорящие,а то хрен поймеш что за апы и дауны,когщда до списков дойдеш будеш так голову вскрывать... wacko.gif yes2.gif
Напомнить, откуда?

У тебя, конечно всякие M, R и тому подобные переменные - говорящие, да? Форматировать программу тоже не мешало бы. Есть утилита PTOP (даже где-то на форуме выкладывалась), если не хочешь делать это вручную.

Procedure SeachAndInsert(P1, P2: point ; x : integer);
var
  flag: boolean;
  saved: Point;
begin
  flag:=true;

  while (P1<>nil) and flag do begin { <--- Обрати внимание !!! }
    if P1^.number = x then begin
      flag := false; saved := P1^.next;
    end
    else begin
      P1 := P1^.next;
    end;
  end;

  P1^.next:=P2;
  while P2^.next<> nil do P2:=P2^.next; { <-- Здесь у тебя тоже был полный бардак }
  P2^.next:=save;
end;

Procedure Create(var p : point; var fin:text);
var
  curr, last: point;
begin
  reset(fin);
  while not seekeof(fin) do begin { А это - чтобы не засовывало лишний ноль в конец списка }
    new(curr);
    read(fin, curr^.number);
    curr^.next := nil;

    if p = nil then p := curr
    else last^.next := curr;

    last := curr;
    write(last^.number:4);
  end;
  close(fin);
end;
Не проверял, Паскаля под рукой нет, но не вижу причин, чтоб не отработало...

Теперь - о том, что я выделил комментариями... У тебя было:
Цитата
while (P1<>nil) and flag=true do
Какая разница между тем, что у меня, и тем, что у тебя? А очень простая: приоритет операции AND выше, чем у операции сравнения, то есть твой код Паскаль интерпретирует так:
while ((P1<>nil) and flag)=true do ...
Хорошо ли это? Я вот не думаю, что хорошо. И надо либо проставлять скобки, чтоб компилятор понял, чего ты хочешь, либо перестать извращаться, и не делать "масло масляное". Без сравнения с true понятно, что While flag аналогично While flag = true, на то и логическая переменная.

Автор: Krjuger 13.05.2009 19:33

Насчет флага,спасибо учту.Насчет говрящих имен..Я про процедуры говорил smile.gif (хотя согласен,мой косяк)

P.S.Других критиковать всегда легче,а если сам что нить непонимаеш,то иногда такие глюпые вещи совершаешь)
В общем ошибки исправил,учел и обещаю исправица yes2.gif А вообще щас по инфе такие вещи начинаются mega_chok.gif ,что я чую я частельно буду обращаться к здешним умам),ну и напоследок полный вариант программы,правда там есть 1 аномалия(после операции в конец второго списка добавляются 2 элемента(последний элемент списка и "0"),но с меня это не требуется да и другие лабы есть,так что если понадобится это легко исправить.

 
Program laba9;
uses CRT;
Type

 point = ^item;       {ЏаҐ¤бв ў«Ґ­ЁҐ бЇЁбЄ  }
 item = record        {‡ўҐ­® бЇЁбЄ }
	 Number: integer;
	 Next: point;   {‘«Ґ¤гойЁ© н«Ґ¬Ґ­в бЇЁбЄ }
	 end;
var
 P1,P2: point;
 A : integer;
 fin1,fin2 : text;

Procedure SeachAndInsert(P1,P2: point ; x : integer);
 var
  flag : boolean;
  save:Point;
 begin
  flag:=true;
  while (P1<>nil) and flag=true do
  begin
   if P1^.number=x then
    begin
    flag:=false;
    save:=P1^.next;
    end
   else
    begin
     P1:=P1^.next;
    end;
  end;
   P1^.next:=P2;
   while P2^.next<> nil do
   P2:=P2^.next;
   P2^.next:=save;
 end;


Procedure Create(var p : point; var fin:text);
 var
 curr,last:point;
 begin
  reset(fin);
  while not seekeof(fin) do
  begin
   new(curr);
   read(fin,curr^.number);
   curr^.next:=nil;
   if p=nil then
    p:=curr
   else
    last^.next:=curr;
    last:=curr;
   end;
   close(fin);
 end;


Procedure BListPrint( P : point );
begin
 write('< ');
 while P <> nil DO
 begin
  write( P^.number );
  If P^.Next <> nil then write(',');
  P := P^.Next
 end;
 writeln(' >')
end;

 begin
 clrscr;
 chdir('C:\Tpascal');
 assign(fin1,'test1.txt');
 assign(fin2,'test2.txt');
 Create(P1,fin1);
 BListPrint(P1);
 Create(P2,fin2);
 BListPrint(P2);
 writeln('‚ўҐ¤ЁвҐ Ї а ¬Ґва Ђ:');
 read(A);
 SeachAndInsert(P1,P2,A);
 BListPrint(P1);
 end.