Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > IT форум > Помощь студентам
Регистрация

Восстановить пароль

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 02.06.2010, 15:27   #1
enigma22
 
Регистрация: 02.06.2010
Сообщений: 3
По умолчанию Паскаль,Кольцевой двунаправленый список

Всем здрасте дело вот в чём незнаю как из ленейнова списка сделать кольцевой двунаправленый вот моя задача :
Описать функцию или процедуру, которая:
а) подсчитывает количество элементов списка L, у которых
равные "соседи" (первый и последний тоже считать со-
седями);
б) в списке L переставляет в обратном порядке все эле-
менты между первым и вторым вхождениями элемента
Е, если Е входит в L не менее двух раз;
вот то что я попытался сделать
Код:
program nom2;
uses crt;
type tukaz=^telem;
     telem=record
	   inf:byte;
	   sled:tukaz;
	   pred:tukaz;
	   end;
var pervl,pervl1,posl,posl1,l,l1,tek,poslkon,p,pervp,hv,nach,pervnach:tukaz;
    x,znach:byte;a:integer;
    b,c:boolean;

procedure VvodSpisL;
begin
clrscr;
writeln('BBedite elementbl spiska (4erez porobel), 0 - priznak conILa');
read(x);
if x<>0 then
   begin
   new(l);
   pervl:=l;
   pervl^.pred:=posl;
   l^.inf:=x;
   read(x);
   while x<>0 do
     begin
     new(l^.sled);
     l:=l^.sled;l^.pred:=l^.sled^.pred;
     l^.inf:=x;
     read(x);
     end;
   readln;
   posl:=l;
   posl^.sled:=pervl;
   end
  else
   begin
   pervl:=nil;
   posl:=nil;
   end;
end;{VvodSpisL}

procedure VvodSpisE;
begin
clrscr;
writeln('BBedite elementbl spiska (4erez porobel), 0 - priznak conILa');
read(x);
if x<>0 then
   begin
   new(l1);
   pervl1:=l1;
   l1^.inf:=x;
   read(x);
   while x<>0 do
     begin
     new(l1^.sled);
     l1:=l1^.sled;
     l1^.inf:=x;
     read(x);
     end;
   readln;
   posl1:=l1;
   posl1^.sled:=nil;
   end
  else
   begin
   pervl1:=nil;
   posl1:=nil;
   end;
end;{VvodSpisE}
procedure ProsmSpisL;
begin
clrscr;
l:=pervl;
while l<>nil do
   begin
   write(l^.inf,' ');
   l:=l^.sled;
   end;
readln;
end;{ProsmSpisL}
procedure ProsmSpisE;
begin
clrscr;
l1:=pervl1;
while l1<>nil do
   begin
   write(l1^.inf,' ');
   l1:=l1^.sled;
   end;
readln;
end;{ProsmSpisE}
procedure Srav;
begin a:=0;
while (l^.inf<>posl)  do begin
if l=l^.pred and l=l^sled then
begin inc(a);l^:=l^sled; end; end;
writeln('Koli4estvo ravnbIx sosedei='a');
end;
procedure Menu;
begin
clrscr;
writeln('1 - Enter L');
writeln('2 - Enter E');
writeln('3 - Procmotr L');
writeln('4 - Procmotr E');
writeln('5 - Srav sosedei siska L');
writeln('');
writeln('===============');
writeln('0 - Exit');
readln(znach);
case znach of
   1: begin
      vvodspisl;
      menu;
      end;
   2: begin
      vvodspisE;
      menu;
      end;
   3: begin
      prosmspisl;
      menu;
      end;
   4: begin
      ProsmSpisE;
      menu;
      end;
   5: begin
      Srav;
      menu;
      end;
   0:
   else
     begin
     writeln('Žè¨¡ª*');
     readln;
     menu;
     end;
   end;
end;{menu}

begin
menu;
end.
я так понял и препод мне сказал что удобней будет сделать кольцевой двунаправленый список чтобы сравнивать элементы первый с последним например а 2 список так и оставить ленейным . помогите плиз последняя прога и всё в ажуре будет

Последний раз редактировалось enigma22; 02.06.2010 в 22:24.
enigma22 вне форума Ответить с цитированием
Старый 08.06.2010, 17:16   #2
enigma22
 
Регистрация: 02.06.2010
Сообщений: 3
По умолчанию

неполучаеца создать кольцевой двунаправленый список и ево вывести вот код может поможе кто
Код:
program nom2;
uses crt;
type tukaz=^telem;
     telem=record
	   inf:integer;
	   sled:tukaz;
	   pred:tukaz;
	   end;
var s1,pervl1,posl,posl1,l,l1,ends,p2,p1,f1,f2:tukaz;
    x,znach:byte;a,buf,i:integer;
    b,c:boolean;

procedure VvodSpisL;
begin
clrscr;
writeln('BBedite kol element spiska ');
read(x);clrscr;
    for i:=1 to x do
      begin
	 new(p1);
	 p1^.inf:=random(10)+1;
	 p1^.sled:=nil;
	 write(p1^.inf,' ');
	 if f1=nil then
	    f1:=p1
	 else
	    begin
	       p2^.pred:=p1;
	       p1^.sled:=p2;
	    end;
	 p2:=p1;
	    if i=1 then begin
		s1:=p1;s1^.sled:=p1^.sled end
		else begin
		if i=x then begin ends:=p1;ends^.pred:=p1^.pred; end;
	 end;
      end;
   f1:=f2;
   s1^.pred:=ends;
   ends^.sled:=s1;readkey;
   end;
procedure VvodSpisE;
begin
clrscr;
writeln('BBedite elementbl spiska (4erez porobel), 0 - priznak conILa');
read(x);
if x<>0 then
   begin
   new(l1);
   pervl1:=l1;
   l1^.inf:=x;
   read(x);
   while x<>0 do
     begin
     new(l1^.sled);
     l1:=l1^.sled;
     l1^.inf:=x;
     read(x);
     end;
   readln;
   posl1:=l1;
   posl1^.sled:=nil;
   end
  else
   begin
   pervl1:=nil;
   posl1:=nil;
   end;
end;{VvodSpisE}
procedure ProsmSpisL;
begin
clrscr;
l:=s1;
while l<>ends  do
   begin
   write(l^.inf,' ');
   l:=s1^.sled;
   end;
readln;
end;{ProsmSpisL}
procedure ProsmSpisE;
begin
clrscr;
l1:=pervl1;
while l1<>nil do
   begin
   write(l1^.inf,' ');
   l1:=l1^.sled;
   end;
readln;
end;{ProsmSpisE}
{procedure Srav;
begin a:=0;
while (l^.inf<>posl)  do begin
if l=l^.pred and l=l^.sled then
begin inc(a);l^:=l^sled; end; end;
writeln('Koli4estvo ravnbIx sosedei='a');
end;}
procedure Menu;
begin
clrscr;
writeln('1 - Enter L');
writeln('2 - Enter E');
writeln('3 - Procmotr L');
writeln('4 - Procmotr E');
writeln('5 - Srav sosedei spiska L');
writeln('6 - pomen9Itb mestami elements mejdy 1 i 2 bxojdeniami spiska L B E');
writeln('===============');
writeln('0 - Exit');
readln(znach);
case znach of
   1: begin
      vvodspisl;
      menu;
      end;
   2: begin
      vvodspisE;
      menu;
      end;
   3: begin
      prosmspisl;
      menu;
      end;
   4: begin
      ProsmSpisE;
      menu;
      end;
  { 5: begin
      Srav;
      menu;
      end;}
     { 6: begin
      ;
      menu;
      end;}
   0:
   else
     begin
     writeln('Žè¨¡ª*');
     readln;
     menu;
     end;
   end;
end;{menu}

begin
menu;
end.
enigma22 вне форума Ответить с цитированием
Старый 17.06.2010, 01:47   #3
enigma22
 
Регистрация: 02.06.2010
Сообщений: 3
По умолчанию

сам решил смотрите кому интересно правдо одна связь неработает последнева елемента с предыдущим благодаря чему нелзя вывести список в обратном порядке
Код:
program nom;
uses crt;
type tukaz=^telem;
     telem=record
	   inf:integer;
	   sled:tukaz;
	   pred:tukaz;
	   end;
var s1,pervl1,posl,posl1,l,l1,ends,p2,p1,f1,f2:tukaz;
    x,znach:byte;a,buf,i,s,t,m,t1:integer;k,g:array[1..50] of integer;
    b,c:boolean;

procedure VvodSpisL;
begin
clrscr;
writeln('BBedite kol element spiska ');
read(x);clrscr; f1:=nil;
    for i:=1 to x do
      begin
	 new(p1);
	 p1^.inf:=random(10)+1;
	 p1^.sled:=nil;
	 write(p1^.inf,' ');
	 if f1=nil then begin
	    f1:=p1;end
	 else
	    begin
	       p2^.sled:=p1;
	       p1^.pred:=p2;
	    end;
	 p2:=p1;
		if i=x then begin
                p1^.sled:=f1;
                p1^.pred:=p2;
                f1^.pred:=p1;
                ends:=p1;
                end;
   end; readkey;end;
procedure VvodSpisE;
begin
clrscr;
writeln('BBedite elementbl spiska (4erez porobel), 0 - priznak conILa');
read(x);
if x<>0 then
   begin
   new(l1);
   pervl1:=l1;
   l1^.inf:=x;
   read(x);
   while x<>0 do
     begin
     new(l1^.sled);
     l1:=l1^.sled;
     l1^.inf:=x;
     read(x);
     end;
   readln;
   posl1:=l1;
   posl1^.sled:=nil;
   end
  else
   begin
   pervl1:=nil;
   posl1:=nil;
   end;
end;{VvodSpisE}
procedure ProsmSpisL;
begin
clrscr;
p1:=f1;
repeat
write(p1^.inf,' ');
p1:=p1^.pred;
until p1=f1;
readln;
end;{ProsmSpisL}
procedure ProsmSpisE;
begin
clrscr;
l1:=pervl1;
while l1<>nil do
   begin
   write(l1^.inf,' ');
   l1:=l1^.sled;
   end;
readln;
end;{ProsmSpisE}
procedure Srav;
begin a:=0;p1:=f1;clrscr;
for i:=1 to x do begin
if p1^.sled^.inf=p1^.pred^.inf  then
begin inc(a); end;p1:=p1^.sled; end;
writeln('Koli4estvo ravnbIx sosedei=',a,'spiska L');
writeln;
p1:=f1;
repeat
write(p1^.inf,' ');
p1:=p1^.sled;
until p1=f1;readkey;
end;
procedure Smena;
begin
clrscr;
writeln('Bbedite E');read(t1);
p1:=f1;
repeat
write(p1^.inf,' ');
p1:=p1^.sled;
until p1=f1;
p1:=f1;a:=0;i:=1;m:=1;
repeat
if p1^.inf=t1 then begin inc(a);
p1:=p1^.sled;
while p1^.inf<>t1 do begin
k[i]:=p1^.inf;inc(i);p1:=p1^.sled;
end;inc(a);
end
else
 p1:=p1^.sled;
until a=2;
m:=1;
for s:=1 to i do begin  g[m]:=k[i-t]; inc(m);inc(t);end;
p1:=f1;a:=0;i:=1;writeln;
repeat
if p1^.inf=t1  then begin inc(a);p1:=p1^.sled;
for s:=2 to m-1 do
begin p1^.inf:=g[s];p1:=p1^.sled;
end;inc(a); end
else
p1:=p1^.sled;
until a=2;
p1:=f1;
repeat
write(p1^.inf,' ');
p1:=p1^.sled;
until p1=f1;
readln;readkey;
end;
procedure Menu;
begin
clrscr;
writeln('1 - Enter L');
writeln('2 - Enter E');
writeln('3 - Procmotr L');
writeln('4 - Procmotr E');
writeln('5 - Srav sosedei spiska L');
writeln('6 - pomen9Itb mestami elements mejdy 1 i 2 bxojdeniami spiska L B E');
writeln('===============');
writeln('0 - Exit');
readln(znach);
case znach of
   1: begin
      vvodspisl;
      menu;
      end;
   2: begin
      vvodspisE;
      menu;
      end;
   3: begin
      prosmspisl;
      menu;
      end;
   4: begin
      ProsmSpisE;
      menu;
      end;
   5: begin
      Srav;
      menu;
      end;
   6: begin
      Smena;
      menu;
      end;
   0:
   else
     begin
     writeln('Žè¨¡ª*');
     readln;
     menu;
     end;
   end;
end;{menu}

begin
menu;
end.
enigma22 вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Си. Кольцевой список F_A_N_Alex Помощь студентам 3 06.10.2009 08:20
КОЛЬЦЕВОЙ ОДНОСВЯЗНЫЙ СПИСОК __FIRST__ Помощь студентам 0 01.11.2008 17:16
Кольцевой список counter Общие вопросы C/C++ 4 20.10.2008 08:09
Кольцевой список blade288 Помощь студентам 3 02.12.2007 20:53