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

> Прочтите прежде чем задавать вопрос!

1. Заголовок темы должен быть информативным. В противном случае тема удаляется ...
2. Все тексты программ должны помещаться в теги [code=pas] ... [/code], либо быть опубликованы на нашем PasteBin в режиме вечного хранения.
3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали!
4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора).
5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM!
6. Одна тема - один вопрос (задача)
7. Проверяйте программы перед тем, как разместить их на форуме!!!
8. Спрашивайте и отвечайте четко и по существу!!!

 
 Ответить  Открыть новую тему 
> Нужна помощ с однонаправленным списком
сообщение
Сообщение #1


Профи
****

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

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


В общем задача заключается в том чтобы после елемента списока 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.Просьба на фак не тыкать прочитал и не один,но если есть конкретные вещи из фака ,тобуду только рад.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #2


Гость






Цитата
В общем моя идея заключалась в том,чтобы создать процедуру,которая будет юзять 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 списка, и сделай то, что я посоветовал...
 К началу страницы 
+ Ответить 
сообщение
Сообщение #3


Профи
****

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

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



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 );хз че сделать.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #4


Гость






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


Профи
****

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

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


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

И еще там внизу я скинул так другую задачу,по сути мне надо создать дек,заполнить его чем либо,и проходя с конца,записывать в пустой стек,но если переносить их по мере прохода от конца до 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;



Сообщение отредактировано: Krjuger -
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #6


Гость






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

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

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

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

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


Профи
****

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

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


"Взять из дека последние 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 -
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #8


Профи
****

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

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


Ну так кто нибуть может что нить дельное по этому поводу сказать?)
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #9


Гость






Цитата
Ну так кто нибуть может что нить дельное по этому поводу сказать?)
Дельное? Пользуйся сам своими же советами:
Цитата(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, на то и логическая переменная.
 К началу страницы 
+ Ответить 
сообщение
Сообщение #10


Профи
****

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

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


Насчет флага,спасибо учту.Насчет говрящих имен..Я про процедуры говорил 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.

 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

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

 





- Текстовая версия 5.12.2020 0:02
500Gb HDD, 6Gb RAM, 2 Cores, 7 EUR в месяц — такие хостинги правда бывают
Связь с администрацией: bu_gen в домене octagram.name