Mail.ruПочтаМой МирОдноклассникиВКонтактеИгрыЗнакомстваНовостиКалендарьОблакоЗаметкиВсе проекты

помогите с решнием задачи на Паскале

Ирина Савёлова Профи (523), на голосовании 16 лет назад
Решение задачи Джозефуса с помощью циклического массива
Голосование за лучший ответ
Артур Кирилюк Мастер (1105) 16 лет назад
{Задача Джозефуса представляет собой своего рода считалку: элементы становятся в круг, вводится некоторое число К. Необходимо, начиная с первого, отсчитать К–й элемент списка и удалить его. Далее отсчет начинается с (К+1)–го элемента и опять удаляется К–й элемент. Так продолжать до тех пор, пока в списке не останется один элемент. }
uses crt;
type
PTelem=^elem;
elem=record
data: integer;
next: PTelem;
end;

procedure Show(first: PTelem; i: integer);
var
p: PTelem;
begin
p:=first;
writeln(i,'-iy prohod:');
repeat
write(p^.data,' ');
p:=p^.next;
until p=first;
writeln;
end;

procedure Jozafus(var q: PTelem; k: integer);
var
i,j: integer;
p: PTelem;
begin
p:=q;
j:=1;
repeat
for i:=1 to k-1 do
begin
p:=q;
q:=q^.next;
end;
p^.next:=q^.next;
dispose(q);
q:=p^.next;
Show(p,j);
inc(j);
until q=q^.next;
end;

function GetData(var k: integer): PTelem;
var
first,last,p: PTelem;
ch: char;
kol: integer;
begin
writeln('Vvedite 1-iy element spiska');
new(p);
readln(p^.data);
p^.next:=nil;
first:=p;
last:=p;
kol:=1;
repeat
new(p);
inc(kol);
p^.next:=first;
writeln('Vvedite ',kol,'-iy element spiska');
readln(p^.data);
first:=p;
last^.next:=p;
writeln('Prodoljit zapolnenie spiska? (Y - da, N - net)');
readln(ch);
until upcase(ch)='N';
write('Vvediite shag - ');
readln(k);
GetData:=first;
end;

procedure MainProc;
var
first: PTelem;
k: integer;
begin
clrscr;
k:=0;
first:=GetData(k);
Jozafus(first,k);
readln;
end;

begin
MainProc;
end.

Похожие вопросы