Помощь - Поиск - Пользователи - Календарь
Полная версия: Списки
Форум «Всё о Паскале» > Pascal, Object Pascal > Задачи
Людмила
:molitva: Ребята объясните мне необходимо решить задачу (я только учусь, если вопросы глупые извините):
Из динамического списка, содержащего последовательность символов, удалить все одинаковые символы, кроме одного.

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

Код

Uses Crt;

Var I,J : Integer;
   Si,So : String;

Begin
    TextColor(White);
    WriteLn('‚введите строку символов -');
    TextColor(LightGray);
    ReadLn(Si);
    For I := Length(Si) DownTo 1 Do
    For J := I-1 DownTo 1 Do Begin
        If Si[I] = Si[J] Then Si[J] := CHR(27);
    End;
    So := '';
    For I := 1 To Length(Si) Do
        If Si[I] <> CHR(27) Then So := So + Si[I];
    TextColor(White);
    WriteLn('Заданная строка после обработки:');
    TextColor(LightGray);
    WriteLn(Si);
    TextColor(White);
    WriteLn('полученная строка содержащия только последние вхождения символов:');
    TextColor(LightGray);
    WriteLn(So);
End.


:p2: прошу не закрывайте эту тему, сильно нужен ответ, сама не могу разобраться.
volvo
Цитата(Людмила @ 12.03.05 16:31)
сколько не читаю не могу понять как эти самые списки описывать.

Вот это прочтите: FAQ: Динамические структуры данных - списки
А если именно это Вы и читали, то в чем именно проблема? Где затруднения? Там ведь есть примеры...
Людмила
Цитата(volvo @ 12.03.05 20:39)
Вот это прочтите: FAQ: Динамические структуры данных - списки
А если именно это Вы и читали, то в чем именно проблема? Где затруднения? Там ведь есть примеры...


Это уже тоже читала... sad.gif ну ни как не пойму как описать понятно, формировние и вывод списка списка тоже, вот обрабатывать (т.е. в моем случае искать повторяющиеся символы и удалять все кроме последнего вхождения символа) ни как не получается, одни ошибки...
volvo
Приведите, пожалуйста, Вашу программу. Возможно ошибки не в обработке, а в описании списка... Без кода очень трудно сказать...
Людмила
Цитата(volvo @ 12.03.05 21:35)
Приведите, пожалуйста, Вашу программу. Возможно ошибки не в обработке, а в описании списка... Без кода очень трудно сказать...


это ввод, формирование и вывод списка... ещё вопрос ни как не придумаю как формировать, что бы не надо было в конце списка вносить определённый символ?
Код

Type ref=^node;
node=record
next:ref;
lit:char;
end;
var inlist,tz:ref;
      a:char;
      i:integer;
begin
  read(a);
  new(inlist);
  tz:=inlist;
  tz^.lit:=a;
  tz^.next:=nil;
while a<>'.' do
  begin
    new(tz^.next);
    read(a);
    tz:=tz^.next;
    tz^.lit:=a;
    tz^.next:=nil;
end;




tz:=inlist;
while tz<>nil do
  begin
    write(tz^.lit);
    tz:=tz^.next;
  end;
end.

а вот алгоритм который реализован в первой моей программе, приведённой веше, сюда не могу добавить... наверное мозгов не хватает unsure.gif
Людмила
Помогите хотя бы советом... :p2:
volvo
Вот, смотрите... Я набросал программку, но предупреждаю сразу: она на всегда корректно работает... Посмотрите, как реализуется работа со списком...
Исходный код
Type
ref=^node;
node=record
next:ref;
lit:char;
end;

tlist = record
first, last: ref;
end;

{ Процедура добавления символа к списку }
procedure append(var list: tlist; ch: char);
var pt: ref;
begin
new(pt);
pt^.lit := ch;
pt^.next := nil;

if list.first = nil then
list.first := pt
else list.last^.next := pt;

list.last := pt;
end;

{ процедура удаления символа из списка }
function remove(from: ref; ch: char): integer;
var
T, prv, pt: ref;
count: integer;
begin
pt := from;
count := 0;

while (pt <> nil) and (pt^.lit = ch) do
begin
T := pt^.next;
dispose(pt);
inc(count);
pt := T;
end;

prv := pt; pt := pt^.next;
while pt <> nil do
begin
if pt^.lit = ch then
begin
prv^.next := pt^.next;
dispose(pt);
inc(count);
pt := prv^.next
end
else
begin
prv := pt;
pt := pt^.next;
end;
end;
remove := count
end;

{ процедура печати содержимого списка }
procedure print(list: tlist);
var p: ref;
begin
p := list.first;
while p <> nil do
begin
write(p^.lit);
p := p^.next
end
end;

var
a:char;

list: tlist;
p: ref;
begin
with list do
begin
first := nil;
last := nil;
end;

repeat
readln(a);
if a <> '.' then
append(list, a);
until a = '.';

p := list.first;
while p <> nil do
begin
if p^.next <> nil then
begin
remove(p^.next, p^.lit);
end;
p := p^.next;
end;

print(list);
end.


Цитата(Людмила @ 15.03.05 17:11)
Помогите хотя бы советом...  :p2:

А вот и совет: "Не пытайтесь объять необъятное" (С) К. Прутков
В смысле, не нужно пытаться ВСЕ действия производить в основной программе. Так очень легко запутаться. Разбейте программу на процедуры, и будет гораздо легче...
Людмила
Цитата(volvo @ 15.03.05 21:48)
Вот, смотрите... Я набросал программку, но предупреждаю сразу: она на всегда корректно работает... Посмотрите, как реализуется работа со списком...

Огромное спасибо!!!! :flowers:
Я посмотрела, только в паскале не могу результат получить, безконечно ввожу символы, а строка не заканчивается... хоть сколько точек ставь. Может я что не так делаю? huh.gif
volvo
Там стоит ReadLn, т.е. после каждого символа надо <Enter> smile.gif Может в этом дело? Тогда поменяйте на Read ...
Людмила
:p1: точно smile.gif
только теперь выдало ошибку после ввода символов "invalid pointer operation" sad.gif
volvo
Людмила
Я проверял вот на такой последовательности:
Цитата
1<enter>2<enter>3<enter>1<enter>1<enter>5<enter>6<enter>4<enter>.<enter>

Ошибок не было...
Результат: 123564
Людмила
Цитата(volvo @ 15.03.05 22:41)
Людмила
Я проверял вот на такой последовательности:
1<enter>2<enter>3<enter>1<enter>1<enter>5<enter>6<enter>4<enter>.<enter>
Ошибок не было...
Результат: 123564

да с цифрами работает, а если вводить различные символы выдаёт ошибку sad.gif , а по условию должны быть различные символы.
volvo
Вот полностью рабочая программа (без тех ограничений, что были раньше):
Исходный код
Type
ref=^node;
node=record
next:ref;
lit:char;
end;

tlist = record
first, last: ref;
end;

procedure append(var list: tlist; ch: char);
var pt: ref;
begin
new(pt);
pt^.lit := ch;
pt^.next := nil;

if list.first = nil then
list.first := pt
else list.last^.next := pt;

list.last := pt;
end;

function remove(from: ref; ch: char): ref;
var
T, prv, pt: ref;
begin
pt := from;
remove := nil;

while (pt <> nil) and (pt^.lit = ch) do
begin
T := pt^.next;
dispose(pt);
pt := T; remove := pt;
end;

prv := pt; pt := pt^.next;
while pt <> nil do
begin
if pt^.lit = ch then begin
prv^.next := pt^.next;
dispose(pt);
pt := prv^.next
end

else begin
prv := pt;
pt := pt^.next;
end;
end;
end;

procedure print(list: tlist);
var p: ref;
begin
writeln;
p := list.first;
while p <> nil do
begin
write(p^.lit);
p := p^.next
end;
writeln;
end;

var
a:char;

list: tlist;
p, pp: ref;
begin
writeln;
with list do
begin
first := nil;
last := nil;
end;

repeat
read{ln}(a);
if a <> '.' then
append(list, a);
until a = '.';

print(list);

p := list.first;
while p <> nil do
begin
if p^.next <> nil then
begin
pp := remove(p^.next, p^.lit);
if pp <> nil then
p^.next := pp
end;
p := p^.next;
end;

print(list);
end.

Тестировалось на: startssdfrtdf.
Ошибок не замечено.

Добавлено:
Если нужно сделать без ввода точки, можно вводить вот так:
Код
{ Вместо: }
 repeat
   read{ln}(a);
   if a <> '.' then
     append(list, a);
 until a = '.';

 { Поставить: }
 readln(st);
 for i := 1 to length(st) do append(list, st[i]);

Ну и естественно описать st: string; i: byte;
Попробуйте... :yes:
Людмила
Цитата(volvo @ 15.03.05 22:41)
Людмила
Я проверял вот на такой последовательности:

Ошибок не было...
Результат: 123564


там почемуто если после первого символа нет entera выдаёт ошибку, а я собираюсь переделать что бы вводить нужно было до entera, т.е. без использования точки (т.к. точка тоже символ)


спасибо за помощь, глядишь и научусь сама писать :D
Людмила
Цитата(volvo @ 15.03.05 23:11)
Если нужно сделать без ввода точки, можно вводить вот так:


Супер, я до этого так же сама тыталась моя ошибка, что я не поставила итый параметр переменой a, тоесть написала append(list, a); (a: string)

:flowers: спасибо, сама бы я не справилась... даже не знаю как выразить свою благодарность... :rose:
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.