0 / 0 / 0
Регистрация: 06.10.2010
Сообщений: 28
1

Считалочка - выбытие игроков, пока не останется три человека

13.10.2010, 22:27. Показов 8730. Ответов 21

Author24 — интернет-сервис помощи студентам
В круг выстраивается N-человек (N<50000). Начиная с первого, неизменно движутся по кругу и исключают каждого М-ого. Когда кто-то выбывает, круг смыкается. Счёт начинается заново со следующего человека в круге.
Процесс продолжается пока не остается ровно 3 человека.
Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
const N=10;
var M, i, i2, Y:integer;
    A:array [1..N] of integer;
begin
{Ввод М}
readln (M);
{Начало цикла, который будет находить каждый M-элемент, выводить его индекс и обновлять количество элементов}
repeat
for i:=1 to N do
i2:=A[i]+M;
Y:=A-A[i+M];
 
write (i2);
until Y=3;
END.
вот мой вариант, но он не работает. подскажите пожалуйста как лучше?
0
Programming
Эксперт
94731 / 64177 / 26122
Регистрация: 12.04.2006
Сообщений: 116,782
13.10.2010, 22:27
Ответы с готовыми решениями:

Найти номер человека который останется в живых
Вот задача One of the talents that Josephus Flavius possessed was the mathematical skill, which...

Повторять n = f(n) до тех пор, пока в n не останется один разряд
Задание: Ввести число n, повторять n = f(n) до тех пор, пока в n не останется один разряд, где f(x)...

Рекурсивные функции. Разделение эл. массива, пока не останется 1 элемент
Вся суть в том что нужно взять массив из 10 элементом и разделить его на пополам (например от 1 до...

Суммировать числа до тех пор, пока не останется 1 число
Почему не работает, и не говорите что 12 строчка. Pascal пишет что там ошибка но ; я поставил...

21
13102 / 5883 / 1706
Регистрация: 19.09.2009
Сообщений: 8,808
14.10.2010, 09:45 2
Лучший ответ Сообщение было отмечено Памирыч как решение

Решение

Если решать в консоли Delphi, то можно и через массивы:
Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
program Project1;
 
{$APPTYPE CONSOLE}
 
uses
  SysUtils,
  Windows;
 
const
  M = 50000;
var
  N, K, i, j : Word;
  Arr : array[1..M] of Word;
  S : String;
begin
  SetConsoleCP(1251);
  SetConsoleOutputCP(1251);
 
  repeat
    Writeln('Задайте начальное количество участников, не более 50000:');
    Readln(N);
    Writeln('Задайте интервал счёта ( >= 1 ):');
    Readln(K);
 
    (*Записываем в массив номера участников.*)
    for i := 1 to N do Arr[i] := i;
 
    i := 1;
    while N > 3 do begin
      (*Выбывает участник с индексом: (i + K - 1) mod N.*)
      i := (i + K - 1) mod N;
      (*Т. к., участник с индексом i выбывает, все участники с бОльшими номерами
      сдвигаются на одну позицию влево.*)
      for j := i to N - 1 do Arr[j] := Arr[j + 1];
      (*Количество участников теперь стало на 1 меньше.*)
      N := N - 1;
    end;
 
    (*Ответ.*)
    Writeln('Остались участники с номерами:');
    for i := 1 to N do begin
      if i > 1 then Write(', ');
      Write(Arr[i]);
    end;
    Writeln;
 
    Writeln('Повторить - Enter, выход - любой символ + Enter.');
    Readln(S);
  until S <> '';
end.
Если в Borland Pascal - то массив с 50000 элементами типа Word превысит размер одного сегмента в памяти - т. е. программа не сможет разместить такой объект.
Размер одного сегмента = 2^16 = 65536 байт.
Размер массива: 50000 * SizeOf(Word) = 50000 * 2 = 100000 байт.
Поэтому, в самом деле, как предлагают Puporev и lexus_ilia, видимо, придётся реализовывать через связанный список.
---
Если задание не запрещает устанавливать количество участников меньшее, чем 50000, тогда в Pascal можно использовать такой код:
Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
program Project1;
 
const
  (*Для Pascal M <= 32768. Так как: 65536 div SizeOf(Word) = 65536 div 2 = 32768.
  Чтобы массив мог разместиться в пределах одного сегмента.*)
  M = 20000;
var
  N, K, i, j : Word;
  Arr : array[1..M] of Word;
  S : String;
begin
  repeat
    Writeln('Задайте начальное количество участников, не более 50000:');
    Readln(N);
    Writeln('Задайте интервал счёта:');
    Readln(K);
 
    (*Записываем в массив номера участников.*)
    for i := 1 to N do Arr[i] := i;
 
    i := 1;
    while N > 3 do begin
      (*Выбывает участник с индексом: (i + K - 1) mod N.*)
      i := (i + K - 1) mod N;
      (*Т. к., участник с индексом i выбывает, все участники с бОльшими номерами
      сдвигаются на одну позицию влево.*)
      for j := i to N - 1 do Arr[j] := Arr[j + 1];
      (*Количество участников теперь стало на 1 меньше.*)
      N := N - 1;
    end;
 
    (*Ответ.*)
    Writeln('Остались участники с номерами:');
    for i := 1 to N do begin
      if i > 1 then Write(', ');
      Write(Arr[i]);
    end;
    Writeln;
 
    Writeln('Повторить - Enter, выход - любой символ + Enter.');
    Readln(S);
  until S <> '';
end.
2
3067 / 727 / 69
Регистрация: 24.09.2008
Сообщений: 1,531
14.10.2010, 09:58 3
Лучший ответ Сообщение было отмечено как решение

Решение

Вот, что у меня получилось, но не советую вводить N>31042, потому что вылетает Stack overflow error (Это в Turbo Pascal'e 7.0, нет возможности проверить на других паскалях):
Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
Program Djozef;
uses
  crt; {Для использования readkey и clrscr}
type
  Tinf=longint; {тип данных, который будет храниться в элементе списка}
  List=^TList;  {Указатель на элемент типа TList}
  TList=record  {А это наименование нашего типа "запись" обычно динамические структуры описываются через запись}
    data:TInf;  {данные, хранимые в элементе}
    next:List;  {указатель на следующий элемент списка}
  end;
 
{Процедура добавления нового элемента в кольцевой список}
procedure AddElem(var nach:List;znach1:TInf);
var
  tmp,tmp1:List;
begin
  if nach=nil then {не пуст ли список, если пуст, то}
  begin
    Getmem(nach,SizeOf(TList)); {создаём элемент, указатель nach уже будет иметь адрес}
    nach^.next:=nach; {никогда не забываем "занулять" указатели}
    tmp:=nach;
  end
  else {если список не пуст}
  begin
    tmp:=nach;
    while tmp^.next<>nach do
      tmp:=tmp^.next;
    GetMem(tmp1,SizeOf(Tlist));
    tmp1^.next:=nach;
    tmp^.next:=tmp1;
    tmp:=tmp1;
  end;
  tmp^.data:=znach1; {заносим данные}
end;
 
{процедура печати списка}
procedure Print(spis1:List);
var
  nach:List;
begin
  if spis1=nil then
  begin
    writeln('Spisok /7Yct.');
    exit;
  end;
  nach:=spis1;
  Write(spis1^.data, ' ');
  spis1:=spis1^.next;
  while spis1<>nach do
  begin
    Write(spis1^.data, ' ');
    spis1:=spis1^.next;
  end;
end;
 
{процедура удаления списка}
Procedure FreeStek(spis1:List);
var
  tmp,nach:List;
begin
  if spis1=nil then
    exit;
  nach:=spis1;
  tmp:=spis1;
  spis1:=spis1^.next;
  dispose(tmp);
  while spis1<>nach do
  begin
    tmp:=spis1;
    spis1:=spis1^.next;
    FreeMem(tmp,SizeOf(Tlist));
  end;
end;
 
{процедура удаления элемента в кольцевом списке}
function DelElem(var spis1:List;tmp:List):List;
var
  tmpi:List;
begin
  if (tmp=nil) or (spis1=nil) then
  begin
    DelElem:=nil;
    exit;
  end;
  if tmp=spis1 then
  begin
    tmpi:=tmp;
    while tmpi^.next<>spis1 do
      tmpi:=tmpi^.next;
    if tmpi=spis1 then
    begin
      spis1^.next:=nil;
      dispose(spis1);
      spis1:=nil;
      DelElem:=nil;
    end
    else
    begin
      tmpi^.next:=tmp^.next;
      spis1:=tmpi^.next;
      dispose(tmp);
      DelElem:=spis1;
    end;
  end
  else
  begin
    tmpi:=spis1;
    while tmpi^.next<>tmp do
      tmpi:=tmpi^.next;
    tmpi^.next:=tmp^.next;
    dispose(tmp);
    DelElem:=tmpi^.next;
  end;
end;
 
var
  SpisNach,yk:List; {указатель на начало списка}
  n,i,m,flag,kol:longint;
begin
  SpisNach:=nil;
  repeat
    clrscr;
    Writeln('Vvedute N (kol-vo 4elovek, N>3)');
    readln(n);
    Writeln('Vvedute M, M>0');
    readln(m);
  until (n>3) and (m>0);
  for i:=1 to n do
  begin
    AddElem(spisNach,i);
  end;
  flag:=n-3;
  yk:=SpisNach;
  kol:=0;
  while kol<>flag do
  begin
    for i:=1 to m-1 do
      yk:=yk^.next;
    yk:=delElem(SpisNach,yk);
    inc(kol);
  end;
  Writeln;
  Writeln;
  Writeln('PoriadkoBble Homepa 4elovek OctaBLLIuecia pocle BblbblTuia:');
  Print(SpisNach);
  readln;
  FreeStek(SpisNach);
end.
4
Почетный модератор
64299 / 47594 / 32743
Регистрация: 18.05.2008
Сообщений: 115,181
14.10.2010, 10:50 4
Лучший ответ Сообщение было отмечено как решение

Решение

Код, предложенный Mawrat, для консоли Делфи , почему-то выдает в Паскаль АВС ошибку выхода за диапазон в строке
Pascal
1
 for j := i to N - 1 do Arr[j] := Arr[j + 1];
Почему, не понял. Написал так.
Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
uses crt;
const nmax=50000;
var a:array[1..nmax-1] of integer;
    n,i,j,k:integer;
begin
clrscr;
//вводим количество
repeat
write('N от 3 до ',nmax-1,' N=');
readln(n);
until (n>3)and(n<nmax);
//интервал удаления
repeat
write('K=');
readln(k);
until k>0;
//расставляем по кругу
for j:=1 to n do
a[j]:=j;
//  начальное значение
j:=0;
repeat
//  вычисляем новое значение
j:=1+(j+k-1)mod n;
 //удаляем из круга
dec(n);
for i:=j to n do
a[i]:=a[i+1];
//корректируем  указатель
dec(j);
until n=3;
writeln;
//выводим результат
writeln('Остались номера:');
for i:=1 to n do
write(a[i],' ');
readln
end.
Все работает, только при N>5000 считает очень долго, а на очень больших значениях даже терпения не хватило дождаться результата.

Добавлено через 18 минут
Кстати взял в Турбо Паскале N=32000, считает быстрее чем в АВС при N=10000.
4
3067 / 727 / 69
Регистрация: 24.09.2008
Сообщений: 1,531
15.10.2010, 00:09 5
Так а у кого-нибудь есть под рукой FPC чтобы проверить мой вариант ? Поставьте точку остановки сразу после добавления всех элементов, если не вылетит, то всё ок.
1
13102 / 5883 / 1706
Регистрация: 19.09.2009
Сообщений: 8,808
15.10.2010, 10:11 6
Lexus_ilia, я твой код запускал в консоли Delphi и в Borland Pascal. Условия: 50000 участников, интервал счёта 25000. Система: Windows XP Pro SP3, двухядерный проц. 2.33 Ггц. Везде отработало без ошибок.
По скорости выполнения:
В Delphi: 15 секунд.
В Pascal: 57 секунд.
Если через массивы в консоли Delphi- скорость больше. Но это и понятно - для обработки динамических списков требуется гораздо больше вычислений.
2
Почетный модератор
64299 / 47594 / 32743
Регистрация: 18.05.2008
Сообщений: 115,181
15.10.2010, 10:44 7
Эта программа в Фрее у меня на фиговом компьютере считала 77 секунд.

Добавлено через 6 минут
На том же фиговом, но в консоли Делфи считало 30 секунд, ответ сошелся....
2
3067 / 727 / 69
Регистрация: 24.09.2008
Сообщений: 1,531
15.10.2010, 23:37 8
Отлично, значит не зря писал) Я очень рад, спасибо, что протестировали...
2
0 / 0 / 0
Регистрация: 06.10.2010
Сообщений: 28
20.10.2010, 20:25  [ТС] 9
всем большое спасибо
0
7 / 7 / 4
Регистрация: 06.02.2010
Сообщений: 131
21.11.2010, 14:50 10
Цитата Сообщение от Puporev Посмотреть сообщение
nmax-1
почему не nmax?
0
Почетный модератор
64299 / 47594 / 32743
Регистрация: 18.05.2008
Сообщений: 115,181
21.11.2010, 14:53 11
Цитата Сообщение от Shetmazafucka Посмотреть сообщение
выстраивается N-человек (N<50000).
Сначала написал, потом заметил, быстро поправил. Можно
const nmax=49999;
тогда [1..nmax];

Добавлено через 29 секунд
Вообще глупый вопрос, лишь бы что-то вякнуть...
0
шарпопочитатель
59 / 26 / 7
Регистрация: 31.01.2010
Сообщений: 1,035
21.11.2011, 15:41 12
а в этой задаче можно наоборот узнать с какого человека начинали мы считать?

То есть имея в качестве данных последнее человека.
0
Почетный модератор
64299 / 47594 / 32743
Регистрация: 18.05.2008
Сообщений: 115,181
21.11.2011, 15:43 13
Конкретно в этой нет, а если переделать, да.
0
шарпопочитатель
59 / 26 / 7
Регистрация: 31.01.2010
Сообщений: 1,035
21.11.2011, 15:49 14
Puporev, а как переделать? Я вот не втыкаю как именно. Смотри, у нас уже все мертвы солдаты например. Остался один. и мы не знаем какой предыдущий был даже. То есть убивать легче чем возрождать)))
Или тут прикол какой то есть? Типо если тот же самый алгоритм запустить с того солдата который выжил, то получим номер того с которого все начиналось?
0
Почетный модератор
64299 / 47594 / 32743
Регистрация: 18.05.2008
Сообщений: 115,181
21.11.2011, 16:37 15
Цитата Сообщение от ht1515 Посмотреть сообщение
Остался один. и мы не знаем какой предыдущий был даже
Почему не знаем, он был на К позиций левее...

Добавлено через 43 секунды
Какая разница вычеркивать или записывать? Только направление сменилось и все.
0
шарпопочитатель
59 / 26 / 7
Регистрация: 31.01.2010
Сообщений: 1,035
21.11.2011, 18:20 16
Puporev, если честно не смотрел ваш код пока. Но есть вариант у меня со связными спиками двунаправленными, так вот там элементы удаляются как бы. То есть там на К позиций не вернешся просто так.
0
Почетный модератор
64299 / 47594 / 32743
Регистрация: 18.05.2008
Сообщений: 115,181
21.11.2011, 19:10 17
Так и здесь удаляются. Вам же не нужны все номера, нужно вставлять пока не все и получите номер первого, он же не номер 1 будет.
0
13102 / 5883 / 1706
Регистрация: 19.09.2009
Сообщений: 8,808
12.06.2013, 17:33 18
Цитата Сообщение от ht1515 Посмотреть сообщение
а в этой задаче можно наоборот узнать с какого человека начинали мы считать?
То есть имея в качестве данных последнее человека.
Здесь, кстати, при решении этой задачи можно использовать расчёт, который обсуждался выше в теме.
Пускай, формулировка задачи будет такой:
В круг выстраивается M-человек. Начиная с некоторого номера N выполняется счёт по кругу. При этом исключают каждого T-го участника. Когда кто-то выбывает, круг смыкается и счёт начинается заново со следующего человека в круге. Процесс продолжается, пока не остается 1 человек - обозначим его номер буквой "K".
Задача - предположим, нам известно: M, T, K, определить номер участника N, с которого начался счёт.
Идея заключается в следующем. Предположим, нам известно, что остался участник под номером 6. Тогда мы берём и запускаем считалочку, начиная с номера 1. В результате получим, например, что остался участник под номером 3. Тогда вычисляем расстояние между начальным участником и оставшимся:
3 - 1 = 2
Теперь, зная расстояние, вычисляем номер начального участника для случая, когда остался участник под номером 6:
6 - N = 2 -> N = 6 - 2 = 4
Ответ - если остался участник под номером 6, то, значит, в этом случае, считать начали с участника под номером 4.
Теперь выведем формулы с учётом цикличности.
Предположим, у нас M участников, мы начали считать с участника под номером N и после счёта остался участник под номером K. Тогда, "расстояние" между участниками N и K равно:
D = K - N
Отсюда следует, что:
N = K - D
С учётом цикличности по модулю M получим:
N = (M + K - D) mod M
Теперь у нас есть формула для определения номера начального участника N, в случае если мы знаем номер последнего оставшегося участника К и расстояние между начальным и конечным участниками D.
Номер оставшегося участника К - мы знаем. Осталось определить расстояние D. Для этого делаем следующее, запускаем расчёт номера оставшегося участника при начале счёта N1=1. В результате получим K1. Отсюда вычислим D:
D = K1 - N1
Теперь, зная M, K и D получим номер участника с которого начался счёт:
N = (M + K - D) mod M
Решение будет выглядеть так:
Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
program Project1;
 
const
  MaxSize = 100; {Наибольшее возможное количество участников.}
var
  M, N, K, D, T, MTmp, i, j : Word;
  Arr : array[1..MaxSize] of Word;
  S : String;
begin
  repeat
    Writeln('Задайте количество участников (1 <= M <= ', MaxSize, '):');
    Readln(M);
    Writeln('Задайте интервал счёта ( >= 1 ):');
    Readln(T);
    Writeln('Задайте номер последнего оставшегося участника ( >= 1 ):');
    Readln(K);
 
    {Записываем в массив номера участников.}
    for i := 1 to M do Arr[i] := i;
    {Выполняем пробный счёт. Начинаем считать с участника под номером 1.}
    MTmp := M;
    i := 1;
    while MTmp > 1 do begin
      {Выбывает участник с индексом: (i + T - 1) mod MTmp.}
      i := (i + T - 1) mod MTmp;
      {Т. к., участник с индексом i выбывает, все участники с бОльшими номерами
      сдвигаются на одну позицию влево.}
      for j := i to MTmp - 1 do Arr[j] := Arr[j + 1];
      {Количество участников теперь стало на 1 меньше.}
      Dec(MTmp);
    end;
    {Теперь мы знаем номер последнего оставшегося участника: Arr[1].
    Вычсляем D:}
    D := Arr[1] - 1; {1 - это номер участника, с которого мы начали пробный счёт.}
    {Теперь вычисляем номер участника, с которого начался счёт для случая, когда
    номер последнего оставшегося участника равен K:}
    N := (M + K - D) mod M;
 
    (*Ответ.*)
    Writeln('Ответ.');
    Writeln('Если остался участник с номером ', K, ',');
    Writeln('то счёт начался с участника под номером: ', N);
 
    Writeln('Повторить - Enter, выход - любой символ + Enter.');
    Readln(S);
  until S <> '';
end.
Добавлено через 2 минуты
Хоть и археология, но я думаю, может кому-нибудь понадобится решение.
0
13 / 13 / 10
Регистрация: 25.05.2015
Сообщений: 554
01.06.2016, 17:35 19
Здравствуйте как вывести тех участников которые выбили?

Добавлено через 6 часов 42 минуты
lexus_ilia, В вашем коде считалочка неверно идет, она у вас начинает со второго элемента считать
0
13102 / 5883 / 1706
Регистрация: 19.09.2009
Сообщений: 8,808
09.06.2016, 08:14 20
Цитата Сообщение от vladis23 Посмотреть сообщение
Здравствуйте как вывести тех участников которые выбили?
Решение на кольцевом динамическом списке.
Выбывание участников идёт до момента, когда останется только 1 участник. Если количество оставшихся участников нужно сделать другое - для этого надо поменять значение в условии цикла WHILE в 131-й строке кода.
Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
program Project1;
 
type
  {Тип основных данных.}
  TData = Integer;
  {Тип указателя на элемент списка.}
  TPElem = ^TElem;
  {Тип элемента списка.}
  TElem = record
    Data : TData;   {Основные данные.}
    PNext : TPElem; {Указатель на следующий элемент списка.}
  end;
  {Сам  кольцевой список будет представлен указателем типа PList : TPElem.
  Этот указатель указывает на последний элемент списка. Последний элемент через
  поле PNext указывает на первый элемент списка PList^.PNext. Таким образом, зная
  указатель на последний элемент, мы легко получаем указатель на первый элемент списка.
  Если в списке только один элемент, то он является первым и последним и указывает
  сам на себя через поле PList^.PNext.
 
{Добавление элемента в конец однонаправленного кольцевого списка (между последним и первым элементами).}
procedure AddL(var aPList : TPElem; const aData : TData);
var
  P : TPElem;
begin
  New(P);
  P^.Data := aData;
  if aPList = nil then {Если список пуст, то новый элемент должен указывать сам на себя.}
    P^.PNext := P
  else                 {Если список непустой, то новый элемент добавляем после последнего элемента.}
  begin
    P^.PNext := aPList^.PNext;
    aPList^.PNext := P;
  end;
  aPList := P; {Новый элемент назначаем последним в списке.}
end;
 
{Освобождение памяти, занятой элементами кольцевого списка и инициализация.}
procedure LFree(var aPList : TPElem);
var
  P, PDel : TPElem;
begin
  P := aPList;
  if P <> nil then
  repeat
    PDel := P;
    P := P^.PNext;
    Dispose(PDel);
  until P = aPList;
  aPList := nil;
end;
 
{Распечатка кольцевого списка.}
procedure LWriteln(const aPList : TPElem);
var
  P : TPElem;
begin
  P := aPList;
  if P = nil then
    Write('Список пуст.')
  else
  repeat
    if P <> aPList then
      Write(', ');
    P := P^.PNext;
    Write(P^.Data);
  until P = aPList;
  Writeln;
end;
 
{Удаление элемента из кольцевого списка по указателю на предыдущий элемент.
Т. е., будет удалён элемент, на который указывает aPPrev^.PNext.}
procedure Del(var aPList, aPPrev : TPElem);
var
  PDel : TPElem;
begin
  if (aPList <> nil) and (aPPrev <> nil) then
  begin
    PDel := aPPrev^.PNext;
    aPPrev^.PNext := PDel^.PNext;
    Dispose(PDel);
    if PDel = aPPrev then      {Если PDel был единственным элементом в списке.}
      aPList := nil
    else if PDel = aPList then {Иначе, если PDel был последним элементом в списке.}
      aPList := aPPrev; {Элемент aPPrev назначаем последним в списке.}
  end;
end;
 
var
  PL, P : TPElem;
  S : String;
  i, N, K, KTmp, Code : Integer;
begin
  {Начальная инициализация списка.}
  PL := nil;
 
  repeat
    Writeln('------------------------------');
    {Ввод количества участников и создание кольцевого списка.}
    repeat
      Write('Задайте количество участников: ');
      Readln(S);
      Val(S, N, Code);
      if (Code <> 0) or (N < 1) then
      begin
        Code := 1;
        Writeln('Неверный ввод. Повторите.');
      end
    until Code = 0;
 
    {Добавляем в список порядковые номера участников.}
    for i := 1 to N do
      AddL(PL, i);
    Write('Участники: ');
    LWriteln(PL);
 
    {Ввод периода счёта.}
    repeat
      Write('Задайте период счёта: ');
      Readln(S);
      Val(S, K, Code);
      if (Code <> 0) or (K < 1) then
      begin
        Code := 1;
        Writeln('Неверный ввод. Повторите.');
      end
    until Code = 0;
 
    {Решение.}
    Write('Выбыли: ');
    P := PL; {Указатель на предыдущего участника.}
    while N > 1 do {Продолжаем считалочку, пока количество участников больше, чем 1.}
    begin
      {Убираем целые периоды и определяем порядковый номер выбывающего участника,
      отсчитывая от текущего участника. Порядковый номер текущего участника = 1.}
      KTmp := K mod N;
      if KTmp = 0 then
        KTmp := N;
      for i := 1 to KTmp - 1 do {Выполняем (KTmp - 1) последовательных переходов.}
        P := P^.PNext;
      Write(P^.PNext^.Data, ' '); {Распечатка номера выбывающего участника.}
      Del(PL, P); {Удаляем из списка элемент, на который указывает P^.PNext.}
      Dec(N);     {Количество элементов в списке уменьшилось на 1.}
    end;
    Writeln;
 
    {Ответ.}
    Write('Оставшиеся участники: ');
    LWriteln(PL);
 
    LFree(PL);
    Writeln('Память, выделенная для списка, освобождена.');
 
    Write('Повторить - Enter. Выход - любой символ + Enter. ');
    Readln(S);
  until S <> '';
end.
 
{
Исключение целых периодов (приведение к нулевой кратности):
KTmp := K mod N;
if KTmp = 0 then
  KTmp := N;
Пояснение:
  Предположим у нас N=10 участников и период счёта K=23. Тогда,
  чтобы определить первого выбывшего участника, мы должны отсчитать 23
  участника, начиная с 1-го. В результате мы дважды по кругу пересчитаем
  всех участников 10 + 10 и на третьем круге остановимся на 3-ем участнике.
  Поэтому нет смысла считать два полных круга, а достаточно в одном круге
  отсчитать третьего участника. Т. е., правило отсчёта будет следующее:
    - если К < N, то KTmp = K mod N;
    - если К = N (в этом случае K mod N = 0), то KTmp = N;
  Например, в данном случае:
    - KTmp = K mod N = 23 mod 10 = 3.
Примечание:
  Каждый раз, когда выбывает очередной участник, следует пересчитывать величину
  KTmp, т. к., количество участников N уменьшается на единицу.
}
Для тех, кто захочет получить расчёт для очень большого количества участников - в этом случае в коде следует закомментовать строки распечатки полного списка и списка выбывших (т. к., эти распечатки будут очень большие): строки №113, №114 и №129, №140.

Возможно, у кого-то будут трудности в понимании, как исключаются целые периоды. Тогда можно взять код, в котором целые периоды не исключаются: Определить порядок удаления ребят из круга
Цитата Сообщение от vladis23 Посмотреть сообщение
lexus_ilia, В вашем коде считалочка неверно идет, она у вас начинает со второго элемента считать
Там всё правильно считается. Обращу внимание, что lexus_ilia писал код в соответствии с условием задачи из заглавного поста темы. А там было сказано:
Цитата Сообщение от Shetmazafucka Посмотреть сообщение
Процесс продолжается пока не остается ровно 3 человека.
0
09.06.2016, 08:14
IT_Exp
Эксперт
87844 / 49110 / 22898
Регистрация: 17.06.2006
Сообщений: 92,604
09.06.2016, 08:14
Помогаю со студенческими работами здесь

Убрать из массива каждое второе число, пока не останется одно
Подскажите, надо написать программу, в которой надо будет ввести максимальное число, затем она...

Постоянный выбор второго элемента списка, пока не останется один
Как лучше реализовать программу которая будет удалят из списка второй элемент ну например как...

Считалка: удаление каждого пятого элемента в списке, пока не останется 1 элемент
Помогите, пожалуйста! Мои знания Lisp'a ограничиваются элементарными на уровне &quot;сумма элементов...

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


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
20
Ответ Создать тему
Опции темы

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin
Copyright ©2000 - 2024, CyberForum.ru