Многосвязные списки, Помощь Опции

[D1ma]

Сдается мне, что ты и не пытался уточнить.. Ладно, твое дело, в конце концов.
Лови.

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;

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

[Krjuger]

вот тебе немног другая реализация,но как я и говрил вполне кустарно....Кстати вопрос больше в Лапу,когда я в дату списка записываю стринг,а потом скидываю строку во временный 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.

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

Сообщение отредактировано: Krjuger - 1.06.2009 20:13

[Lapp]

последняя строка символов не проверяется на длину,

Да, ошибся я. Секундочку..
Ну, вот так можно, наверное..

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. А то тут одна строка кода сдублирована...



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

[Krjuger]

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

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


Сообщение отредактировано: Krjuger - 1.06.2009 20:20

[Lapp]

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

Добавлено через 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]

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

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

Код

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]

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

[D1ma]

Решил сначала попробывать с использованием типа 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]

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

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]

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

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]

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


L1:=L;

s1:=s;

L:=Next;

s:=Next;

L:=Next;



Сообщение отредактировано: D1ma - 8.06.2009 16:03

[Lapp]

немогли бы написать действие след. операторов?

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

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

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

[D1ma]

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

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]

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