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

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

Форум «Всё о Паскале» _ Задачи _ Многосвязные списки

Автор: D1ma 14.04.2009 0:15

Всем привет.Требуется помощь в написании программы с использованием многосвязных список. Тему плохо понял, поэтому требуется помощь.
Задание: Найти короткую строку.
Сам код программы есть, требуется лишь поспотроить МС -)

 VAR
F:TEXT;
I:WORD;
C:CHAR;
N:WORD;
BEGIN
CLRSCR;
	 ASSIGN(F,'C:\F1.TXT');
	 RESET(F);
	 I:=0;
	 N:=60000;
	 WHILE NOT EOF(F) DO
	 BEGIN
		  IF EOLN(F) THEN
		  BEGIN
			   IF I<N THEN N:=I;
			   I:=0;
			   READ(F,C);
			   READ(F,C);
		  END;
		  READ(F,C);
		  I:=I+1;
	 END;
	 IF I<N THEN N:=I;
	 IF N=60000 THEN I:=0 ELSE I:=N;
	 WRITE('MIN = ');
	 WRITELN(I);

END.

Автор: volvo 14.04.2009 0:18

Что в твоем понимании МС? Двухсвязный список? Мульти-список? Насколько МНОГОсвязным должен быть список?

Автор: D1ma 14.04.2009 0:45

Цитата(volvo @ 13.04.2009 21:18) *

Что в твоем понимании МС? Двухсвязный список? Мульти-список? Насколько МНОГОсвязным должен быть список?

я как понял мульти-список

Автор: volvo 14.04.2009 0:50

Что ты хочешь делать с мультисписком? Читать в него весь файл что-ли?
(Кстати, я помню, когда-то выкладывал программу, строящую мультисписок, посмотри в поиске.)

Автор: D1ma 16.04.2009 18:29

Вот что получилось smile.gif :

Код
USES CRT;
CONST
PATH='C:\F1.TXT';
TYPE
DATA=STRING;
LINK=^RS;
RS=RECORD VAL:DATA;
          LNK:LINK;
          END;
TF=TEXT;
VAR
F:TF;
A:LINK;
B:WORD;

PROCEDURE ADD(VAR A:LINK;B:DATA);
BEGIN
     IF A<>NIL THEN ADD(A^.LNK,B) ELSE
     BEGIN
          NEW(A);
          A^.VAL:=B;
          A^.LNK:=NIL;
     END;
END;

PROCEDURE LOAD(VAR F:TF;VAR A:LINK);
VAR
I:DATA;
BEGIN
     ASSIGN(F,PATH);
     RESET(F);
     A:=NIL;
     WHILE NOT EOF(F) DO
     BEGIN
          READLN(F,I);
          ADD(A,I);
     END;
END;

PROCEDURE OUTPUT(A:LINK);
BEGIN
     WHILE A<>NIL DO
     BEGIN
          WRITELN(A^.VAL);
          A:=A^.LNK;
     END;
END;

PROCEDURE MIN(A:LINK;VAR B:WORD);
VAR
I:WORD;
BEGIN
     B:=256;
     WHILE A<>NIL DO
     BEGIN
          IF LENGTH(A^.VAL)<B THEN B:=LENGTH(A^.VAL);
          A:=A^.LNK;
     END;
     IF B=256 THEN B:=0;
END;

BEGIN
     CLRSCR;
     LOAD(F,A);
     OUTPUT(A);
     MIN(A,B);
     WRITELN;
     WRITELN('MIN=',B);
     READLN;
END.

Токо вот нужно без использования STRING, подравьте чуток - smile.gif

Автор: D1ma 27.05.2009 20:49

Помогите исправить процедуру MIN. Список сформирован, необходимо найти длину короткой строки, используя CHAR.

SES CRT;
CONST
PATH='C:\F1.TXT';
TYPE
DATA=CHAR;
LINK=^RS;
RS=RECORD VAL:DATA;
LNK:LINK;
END;
TF=TEXT;
VAR
F:TF;
A:LINK;
B:WORD;

PROCEDURE ADD(VAR A:LINK;B:DATA);
BEGIN
IF A<>NIL THEN ADD(A^.LNK,B) ELSE
BEGIN
NEW(A);
A^.VAL:=B;
A^.LNK:=NIL;
END;
END;

PROCEDURE LOAD(VAR F:TF;VAR A:LINK);
VAR
I:DATA;
BEGIN
ASSIGN(F,PATH);
RESET(F);
A:=NIL;
WHILE NOT EOF(F) DO
BEGIN
READ(F,I);
ADD(A,I);
END;
END;

PROCEDURE OUTPUT(A:LINK);
BEGIN
WHILE A<>NIL DO
BEGIN
WRITE(A^.VAL);
A:=A^.LNK;
END;
END;

PROCEDURE MIN(A:LINK;VAR B:WORD);
VAR
I:WORD;
BEGIN
	 B:=256;
	 WHILE A<>NIL DO
	 BEGIN
		  IF LENGTH(A^.VAL)<B THEN B:=LENGTH(A^.VAL);
		  A:=A^.LNK;
	 END;
	 IF B=256 THEN B:=0;
END;

BEGIN
CLRSCR;
LOAD(F,A);
OUTPUT(A);
MIN(A,B);
WRITELN;
WRITELN('MIN=',B);
READLN;
END.

Автор: Krjuger 27.05.2009 21:28


PROCEDURE MIN(A:LINK;VAR B:WORD);
VAR
I:WORD;
ch:integer;
BEGIN
     B:=256;
     WHILE A<>NIL DO
      BEGIN
        WHILE not eol(A^.Val) DO{либо eol либо eoln}
          ch:=ch+1;
      
      IF ch<B THEN B:=ch;
      A:=A^.LNK
      END;
     IF B=256 THEN B:=0;
END;


Понимаеш char это одна буква,по сути ты находиш длинну, считывая строку побуквенно,зачем это делать я хз,но суть того, что я написал, мы берем строку и до тех пор пока не конец накручиваем счетчик ch, потом берем следующую опять накручиваем и сравниваем,меньшее записывает.

Автор: D1ma 27.05.2009 23:35

Цитата(Krjuger @ 27.05.2009 18:28) *


PROCEDURE MIN(A:LINK;VAR B:WORD);
VAR
I:WORD;
ch:integer;
BEGIN
     B:=256;
     WHILE A<>NIL DO
      BEGIN
        WHILE not eol(A^.Val) DO{либо eol либо eoln}
          ch:=ch+1;
      
      IF ch<B THEN B:=ch;
      A:=A^.LNK
      END;
     IF B=256 THEN B:=0;
END;


Понимаеш char это одна буква,по сути ты находиш длинну, считывая строку побуквенно,зачем это делать я хз,но суть того, что я написал, мы берем строку и до тех пор пока не конец накручиваем счетчик ch, потом берем следующую опять накручиваем и сравниваем,меньшее записывает.

то что char это 1 символ прекрасно понимаю smile.gif
Ну вот задали так...
Но ведь Eoln это ведь только для файловой переменной. а тут список...
Как быть?

Автор: Krjuger 28.05.2009 0:04

Ну у меня то eoln не для списка,а только для A^.Val,а это string часть,для нее должно работать.а вообще подожди щас проверю.
мда действительно нельзя,извиняюсь.Тогда сделай так.


cch:char;
...........
WHILE A<>NIL DO
      BEGIN
        read(A^.Val,cch);
        WHILE cch<>#13  DO{13-это enter}
             begin
               read(A^.Val,cch);
.................


так должно работать.

Автор: D1ma 28.05.2009 23:17

Немного не понял, а почему именно 'enter'?

Автор: Krjuger 29.05.2009 0:35

Ну а что ты нажимаеш,когда хочеш перейти на новую строку?Я вроде нажимаю enter.Поэтому логично,что если элемент char равен enter,то ты автоматически попадаеш на новую строку.

Автор: D1ma 31.05.2009 20:03

эх, что-то не работает...
пробывал по всякому, но что-то не получается (
Кто сможет сделать за небольшое вознаграждение?

Автор: Krjuger 31.05.2009 20:06

За вознаграждение,это уже немного в другую тему.

Автор: Lapp 1.06.2009 12:10

Krjuger, я понимаю, что

Цитата
Не ругайте сильно,я только учусь.
- но почему ты заставляешь других учиться на твоих ошибках? Еще раз: проверяй свои творения перед публикацией! И учи матчасть.. smile.gif

D1ma, мне как-то странно, что у тебя данные имеют тип char, а не string (как в начале). Можешь пояснить? Ты понимаешь, что LENGTH(A^.VAL) всегда будет давать 1 в этом случае?

Ты не паникуй, сделаем. Только ты говори яснее, что ты хочешь получить и как.


Автор: Krjuger 1.06.2009 17:18

Действительно,зачем ты тип данных в списке сменил???ведь у тебя теперь в дате всего 1 элемент,мой кусочек тоже рабоать так не станет..Кстати скинь заново весь код с исправления внесенными тобой...а то
"пробывал по всякому, но что-то не получается (" очень мало о чем гворит,ты же не сказал,что изменил

Автор: D1ma 1.06.2009 18:19

Цитата(Lapp @ 1.06.2009 9:10) *

Krjuger, я понимаю, что - но почему ты заставляешь других учиться на твоих ошибках? Еще раз: проверяй свои творения перед публикацией! И учи матчасть.. smile.gif

D1ma, мне как-то странно, что у тебя данные имеют тип char, а не string (как в начале). Можешь пояснить? Ты понимаешь, что LENGTH(A^.VAL) всегда будет давать 1 в этом случае?

Ты не паникуй, сделаем. Только ты говори яснее, что ты хочешь получить и как.

Первый вариант рабочий, но как оказалось нельзя использовать STRING, а только CHAR.( до сих пор не пойму почему)
Далее string поменял на char,чуток подправил,посимвольный ввод работает.
Но вот как изменить процедуру min, я так и не додумался...

p.s. Вариант, предложенный Krjuger не работает.
read(A^.Val,cch); это допустимо только же для файлов? а тут список.

Автор: Lapp 1.06.2009 18:30

Цитата(D1ma @ 1.06.2009 15:19) *
read(A^.Val,cch); это допустимо только же для файлов? а тут список.
Да, конечно.
То есть, ты имеешь в виду, что в каждом элементе списка только один символ?
Будь добр, подтверди (а лучше опровергни)), ибо мне все равно не верится в такое диво.
Может, переспросишь препа? или кого-нить еще..

В принципе, ничего особо трудного, ибо концы строк ты тоже заносишь в список.. но странно)).

Автор: D1ma 1.06.2009 20:04

Цитата(Lapp @ 1.06.2009 15:30) *

Да, конечно.
То есть, ты имеешь в виду, что в каждом элементе списка только один символ?
Будь добр, подтверди (а лучше опровергни)), ибо мне все равно не верится в такое диво.
Может, переспросишь препа? или кого-нить еще..

В принципе, ничего особо трудного, ибо концы строк ты тоже заносишь в список.. но странно)).


Ну получается что только один символ, т.к. char, получается что подтверждаю smile.gif)


Автор: Krjuger 1.06.2009 21:13

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

Автор: Lapp 1.06.2009 22:29

Цитата(D1ma @ 1.06.2009 17:04) *
Ну получается что только один символ, т.к. char, получается что подтверждаю smile.gif)
Сдается мне, что ты и не пытался уточнить.. Ладно, твое дело, в конце концов.
Лови.
PROCEDURE MIN(A:LINK;VAR B:WORD);
VAR
  I:WORD;
BEGIN
  B:=256;
  i:=0;
  WHILE A<>NIL DO begin
    case A^.VAL of
      #13: ;
      #10: begin
        if i<b then b:=i;
        i:=0
      end
      else Inc(i)
    end;
    A:=A^.LNK;
  END
END;


Автор: D1ma 1.06.2009 23:15

Цитата(Lapp @ 1.06.2009 19:29) *

Сдается мне, что ты и не пытался уточнить.. Ладно, твое дело, в конце концов.
Лови.
PROCEDURE MIN(A:LINK;VAR B:WORD);
VAR
  I:WORD;
BEGIN
  B:=256;
  i:=0;
  WHILE A<>NIL DO begin
    case A^.VAL of
      #13: ;
      #10: begin
        if i<b then b:=i;
        i:=0
      end
      else Inc(i)
    end;
    A:=A^.LNK;
  END
END;


Спасибо smile.gif
только помойму последняя строка символов не проверяется на длину, т.к. если его длина меньше остальных
то не выдается его длина

Автор: Krjuger 2.06.2009 0:11

вот тебе немног другая реализация,но как я и говрил вполне кустарно....Кстати вопрос больше в Лапу,когда я в дату списка записываю стринг,а потом скидываю строку во временный txt файл,то у меня окончание ознаменуется #26 это конец файла чтоли или как?


USES CRT;
CONST
PATH='C:\TPascal\F1.TXT';
TYPE
DATA=string;
LINK=^RS;
RS=RECORD VAL:DATA;
LNK:LINK;
END;
TF=TEXT;
VAR
F:TF;
A:LINK;
B,ch:WORD;
cch:char;
str:text;

PROCEDURE ADD(VAR A:LINK;B:DATA);
BEGIN
IF A<>NIL THEN ADD(A^.LNK,B) ELSE
BEGIN
NEW(A);
A^.VAL:=B;
A^.LNK:=NIL;
END;
END;

PROCEDURE LOAD(VAR F:TF;VAR A:LINK);
VAR
I:DATA;
BEGIN
ASSIGN(F,PATH);
RESET(F);
A:=NIL;
WHILE NOT EOF(F) DO
BEGIN
READ(F,I);
ADD(A,I);
readln(f);
END;
END;

PROCEDURE OUTPUT(A:LINK);
BEGIN
WHILE A<>NIL DO
BEGIN
WRITE(A^.VAL);
A:=A^.LNK;
writeln;
END;
END;

PROCEDURE MIN(A:LINK;VAR B:WORD);
VAR
I:WORD;
BEGIN
	 B:=256;
	 WHILE A<>NIL DO
	 BEGIN
      ch:=0;
      rewrite(str);
      write(str,a^.val);
      reset(str);
      read(str,cch);
      while cch<>#26 do begin
       read(str,cch);
       ch:=ch+1;
      end;
		  IF ch<B THEN B:=ch;
		  A:=A^.LNK;
	 END;
	 IF B=256 THEN B:=0;
END;

BEGIN
CLRSCR;
assign(str,'C:\TPascal\f2.txt');
LOAD(F,A);
OUTPUT(A);
MIN(A,B);
WRITELN;
WRITELN('MIN=',B);
READLN;
END.


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

Автор: Lapp 2.06.2009 0:13

Цитата(D1ma @ 1.06.2009 20:15) *
последняя строка символов не проверяется на длину,
Да, ошибся я. Секундочку..
Ну, вот так можно, наверное..
PROCEDURE MIN(A:LINK;VAR B:WORD);
VAR
  I:WORD;
BEGIN
  B:=256;
  i:=0;
  WHILE A<>NIL DO begin
    case A^.VAL of
      #13: ;
      #10: begin
        if i<b then b:=i;
        i:=0
      end
      else Inc(i)
    end;
    A:=A^.LNK;
  END;
  if i<b then b:=i;
END;

Только ты спрячь и не показывай volvo. А то тут одна строка кода сдублирована...
smile.gif


Добавлено через 1 мин.
Пожалуйста, не надо всякий раз цитировать ВЕСЬ предыдущий мессадж при ответе.

Автор: Krjuger 2.06.2009 0:16

Цитата

Только ты спрячь и не показывай volvo. А то тут одна строка кода сдублирована...

УУУУууу.....молись,в прошлый раз volvo конкурс устроил,как избавиться от условия))))Растерзает ведь...

Автор: Lapp 2.06.2009 0:27

Нет, погоди, так снова неправильно. Дай минутку.

Добавлено через 12 мин.
Вот так будет правильно:

PROCEDURE MIN(A:LINK;VAR B:WORD);
VAR
  I:WORD;
BEGIN
  B:=256;
  i:=0;
  WHILE A<>NIL DO begin
    case A^.VAL of
      #13: ;
      #10: begin
        if i<b then b:=i;
        i:=0
      end
      else Inc(i)
    end;
    A:=A^.LNK;
  END;
  if (0<i)and(i<b) then b:=i else if b=256 then b:=0
END;


Автор: D1ma 4.06.2009 22:53

в общем, оказалось что это вовсе не многосвязный список... nea.gif

Как же надоела эта задача... mad.gif

Код

uses crt;
type slov=^slovo;
     slovo=record
     sim:char;
     ss:slov;
     end;
     spisok=^zveno;
     zveno=record
     sl:slov;
     cc:spisok;
     end;
var s,s1,s2:spisok;
    t:text;
    b,i:word;
begin
clrscr;
assign(t,'C:/f1.txt');
reset(t);
s1:=nil;
while not eof(t) do begin
new(s);
s2^.sl:=nil;
  while not eoln(t) do begin
   new(s^.sl);
   read(t,s^.sl^.sim);
   s^.sl^.ss:=s2^.sl;
   s2^.sl:=s^.sl;
  end;
readln(t);
s^.cc:=s1;
s1:=s;
end;
close(t);

while s<>nil do begin
while s^.sl<>nil do begin
  write(s^.sl^.sim);
  s^.sl:=s^.sl^.ss;
end;
writeln;
s:=s^.cc;
end;

b:=256;
i:=0;
While S<>nil do begin
Case S^.sl^.sim of
      #13:;
      #10: begin
if i<b then b:=i;
        i:=0
      end
      else Inc(i)
    end;
     s:=s^.cc;
end;
if (0<i)and(i<b) then b:=i else if b=256 then b:=0;
write('MIN=',b);
end.

Вроде как формирует из файла многосвязный список, только строки наоборот ))
По аналогии вычисление длины короткой строки написал вроде как в предыдущей программе, только что-то не работает...
Помогите плз, осталась единственная несданная задача...


Автор: D1ma 6.06.2009 11:17

Блин...
В чем ошибка?

Автор: D1ma 6.06.2009 22:35

Решил сначала попробывать с использованием типа STRING, c ним все просто

Код

b:=256;
while s<>nil do begin
while s^.sl<>nil do begin
write(s^.sl^.sim);
if length(S^.sl^.sim)<b then b:=length(S^.sl^.sim);
s^.sl:=s^.sl^.ss;
end;
writeln;
s:=s^.cc;
end;write(b);


Но нужно с использованием Char.
В общем считает, но не отдельную строку, а всю длину.
Код

hile s<>nil do begin
while s^.sl<>nil do begin
  write(s^.sl^.sim);

Case S^.sl^.sim of
      #13:;
      #10: begin
if i<b then b:=i;
        i:=0
      end
      else Inc(i)
    end;
    
end;

s^.sl:=s^.sl^.ss;
end;
writeln;
s:=s^.cc;
end;
if (0<i)and(i<b) then b:=i else if b=256 then b:=0;
write('MIN=',b);

Как сделать чтобы считал не всю длину, а токо длину строки?

Автор: D1ma 7.06.2009 0:08

Решил попробывать вот так:


while s<>nil do begin
Case S^.sl^.sim of
	  #13:;
	  #10: begin
if i<b then b:=i;
		i:=0
	  end
	  else Inc(i)
	end;

while s^.sl<>nil do begin
  write(s^.sl^.sim);

s^.sl:=s^.sl^.ss;
end;
writeln;
s:=s^.cc;
end;
if (0<i)and(i<b) then b:=i else if b=256 then b:=0;
write('MIN=',b);


Почему-то мне кажется что должно быть так, но считает неверно...

М
 Пожалуйста, пользуй тэги code=pas /code


Автор: Lapp 7.06.2009 0:21

Я довольно много поменял тут..
Разберешься?

type
  pSlovo= ^Slovo;
  Slovo= record
    c: char;
    Next: pSlovo;
  end;
  pSpisok=^Spisok;
  Spisok=record
    s,s1: pSlovo;
    Next: pSpisok;
  end;

var
  L,L1: pSpisok;
  t: text;
  b,i: word;

begin
  assign(t,'f1.txt');
  reset(t);
  L:=nil;
  while not eof(t) do begin
    if L=nil then begin
      New(L);
      L1:=L
    end
    else begin
      New(L^.Next);
      L:=L^.Next
    end;
    with L^ do begin
      next:=nil;
      s:=nil;
      while not eoln(t) do with s^ do begin
        if s=nil then begin
          New(s);
          s1:=s
        end
        else begin
          New(s^.next);
          s:=s^.next
        end;
        with  s^ do begin
          read(t,c);
          next:=nil
        end
      end;
      readln(t);
    end
  end;
  close(t);

  L:=L1;
  while L<>nil do with L^ do begin
    s:=s1;
    while s<>nil do with s^ do begin
      write©;
      s:=Next
    end;
    writeln;
    L:=Next
  end;

  b:=256;
  L:=L1;
  while L<>nil do with L^ do begin
    i:=0;
    s:=s1;
    while s<>nil do with s^ do begin
      case c of
        #13:;
        #10: begin
          if i<b then b:=i;
          i:=0
        end
        else Inc(i)
      end;
      s:=Next
    end;
    L:=Next
  end;
  if (0<i)and(i<b) then b:=i else if b=256 then b:=0;
  write('MIN=',b)
end.

Автор: D1ma 8.06.2009 20:01

Спасибо!!! smile.gif
Плохо разобрался токо, немогли бы написать действие след. операторов? -)


L1:=L;

s1:=s;

L:=Next;

s:=Next;

L:=Next;


Автор: Lapp 8.06.2009 23:35

Цитата(D1ma @ 8.06.2009 17:01) *
немогли бы написать действие след. операторов?
Ты лучше в программе комментами пиши, какое именно место непонятно и почему.

L1:=L;
s1:=s;
- запомнить начало списка

L:=Next;
s:=Next;
- продвижение вперед по списку

Автор: D1ma 9.06.2009 20:09

Исправьте что не так smile.gif 


while not eof(t) do begin
    if L=nil then begin
      New(L);
      L1:=L  {Запоминаем начало списка}
    end
    else begin
      New(L^.Next);
      L:=L^.Next {переход на след. элемент}
    end;
    with L^ do begin
      next:=nil;{обнуляем ссылку}
      s:=nil;
      while not eoln(t) do with s^ do begin
        if s=nil then begin
          New(s);
          s1:=s {Запоминаем начало подсписка}
        end
        else begin
          New(s^.next);
          s:=s^.next {переход на след. элемент}
        end;
        with  s^ do begin
          read(t,c);
          next:=nil {обнуляем ссылку}
        end
      end;
      readln(t) ; {?} 
    end
  end;
  close(t);

  L:=L1;
  while L<>nil do with L^ do begin
    s:=s1; {Запоминаем начало подсписка}
    while s<>nil do with s^ do begin 
      write©;
      s:=Next {продвижение вперед по списку}
    end;
    writeln;
    L:=Next  {продвижение вперед по списку}
  end; 

  b:=256;
  L:=L1;
  while L<>nil do with L^ do begin
    i:=0;
    s:=s1;
    while s<>nil do with s^ do begin
      case c of
        #13:;
        #10: begin
          if i<b then b:=i;
          i:=0
        end
        else Inc(i)
      end;
      s:=Next {продвижение вперед по списку}
    end;
    L:=Next {продвижение вперед по списку}
  end;


Автор: Krjuger 10.06.2009 17:54

Ну а ты скажи,что не так и тебе исправят..Где ошибка,то? что тебя не устраивает?Уу тебя в руках всегда есть встроеный в паскаль дебагер,где ты можеш проверить все изменения переменных при каждом шаге,только для этого надо самому понимать,что должно происходить и что произошло и смотреть где именно ошибка,и тогда уже думать,как это исправить.