задача "считалка" Опции

[Sofo4ka]

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

[volvo]

Поиск по форуму, ключевое слово - "Казнь"... Чуть-чуть модифицировать, и получишь то, что тебе нужно...

[Sofo4ka]

спасибо

что то очень тяжелая,легче никак?

[klem4]

Так пойдет ?

uses crt;

const

  max_len = 255;

type

  TArray = array [1..max_len] of Integer;

procedure Fill(var arr: TArray; n: Integer);
var
  i: Integer;
begin
  for i := 1 to n do arr[i] := i;
end;

procedure Print(const arr: TArray; const n: Integer);
var
  i: Integer;
begin
  writeln;
  for i := 1 to n do write(arr[i]:3);
  writeln;
end;

procedure Del(var arr: TArray; var n: Integer; const p: Integer);
var
  i: Integer;
begin
  for i := p to n - 1 do
   arr[i] := arr[i + 1];
  n := n - 1;
end;

function GetNext(var arr: TArray; var n: Integer; var p: Integer; shift: Integer): Integer;
var
  tShift: Integer;
begin

  if p + shift <= n then begin
    p := p + shift;
  end
   else begin
     tShift := shift - (n - p);
     p := 0;
     while (tShift > n) do tShift := tShift - n;
     p := tShift;
   end;

   Del(arr, n, p);
   GetNext := p;
   Dec(p);
end;

procedure GetSequence(arr: TArray; n, shift: Integer);
var
  p: Integer;
begin
  p := 0;
  while (n > 0) do begin
    GetNext(arr, n, p, shift);
    Print(arr, n);
  end;
end;

var
  a: TArray;
  n, shift: Integer;

begin
  clrscr;
  write('N = '); readln(n);
  write('Shift = '); readln(shift);
  Fill(a, n);
  clrscr;
  Print(a, n);
  GetSequence(a, n, shift);
  readln;
end.

n = 7
shift = 9


1 2 3 4 5 6 7
1 3 4 5 6 7
1 3 4 6 7
1 4 6 7
1 6 7
6 7
7

[Sofo4ka]

да спс

[dize]

А не подскажите как вывести последовательность выбывших? Столкнулся с подобной задачей, а паскаль уже почти не помню.

[Виктор]

Так пойдет ?

uses crt;

const

  max_len = 255;

type

  TArray = array [1..max_len] of Integer;

procedure Fill(var arr: TArray; n: Integer);
var
  i: Integer;
begin
  for i := 1 to n do arr[i] := i;
end;

procedure Print(const arr: TArray; const n: Integer);
var
  i: Integer;
begin
  writeln;
  for i := 1 to n do write(arr[i]:3);
  writeln;
end;

procedure Del(var arr: TArray; var n: Integer; const p: Integer);
var
  i: Integer;
begin
  for i := p to n - 1 do
   arr[i] := arr[i + 1];
  n := n - 1;
end;

function GetNext(var arr: TArray; var n: Integer; var p: Integer; shift: Integer): Integer;
var
  tShift: Integer;
begin

  if p + shift <= n then begin
    p := p + shift;
  end
   else begin
     tShift := shift - (n - p);
     p := 0;
     while (tShift > n) do tShift := tShift - n;
     p := tShift;
   end;

   Del(arr, n, p);
   GetNext := p;
   Dec(p);
end;

procedure GetSequence(arr: TArray; n, shift: Integer);
var
  p: Integer;
begin
  p := 0;
  while (n > 0) do begin
    GetNext(arr, n, p, shift);
    Print(arr, n);
  end;
end;

var
  a: TArray;
  n, shift: Integer;

begin
  clrscr;
  write('N = '); readln(n);
  write('Shift = '); readln(shift);
  Fill(a, n);
  clrscr;
  Print(a, n);
  GetSequence(a, n, shift);
  readln;
end.

n = 7
shift = 9
1 2 3 4 5 6 7
1 3 4 5 6 7
1 3 4 6 7
1 4 6 7
1 6 7
6 7
7

Можешь помочь?не могу понять что делать эта функция i:=i mod n+1
Program schitalka;
Const nmax=100;
Var n,m,I,j:integer;
Krug: set of 1..nmax;
Begin
Write(‘введите число человек: ’); read(n);
Write(‘кого удалять?: ’); read(m);
If (n>500) or (m>100) then write(‘ошибка’)
Else begin
Krug:=[1..n];
I:=n;
End;
Repeat
For j:=1 to m do
Repeat
I:=I mod n+1
Until I in krug;
Write(i:3);
Krug:=krug-[i]
Until krug=[ ];
Write(‘номер уцелевшего: ’,i);
End.