Program AISD_1_2; {$APPTYPE CONSOLE} {$R *.res} Uses System.SysUtils; Type TPElem = ^TElem; TElem = Record Data: Integer; Next: TPElem; End; Function CreateRoundList(NumberOfPlayers: Integer): TPElem; // создание списка от 1 до NumberOfPlayers Var Head, CurrentEl, TempPointer: TPElem; I: Integer; Begin New(CurrentEl); Head := CurrentEl; I := 1; While I <= NumberOfPlayers Do Begin TempPointer := CurrentEl; CurrentEl^.Data := I; New(CurrentEl); TempPointer^.Next := CurrentEl; Inc(I); End; TempPointer^.Next := Head; Result := Head; End; Procedure DeleteData(Var Head: TPElem); //удаление Begin Write(Head^.Next^.Data, ' '); Head^.Next := Head^.Next^.Next; End; Procedure CountDown(Var Head: TPElem; Gap: Integer); // пересчет выбывших Var I: Integer; Begin Write('Выбывшие: '); While Head <> Head^.Next Do Begin For I := 1 To Gap - 2 Do Head := Head^.Next; DeleteData(Head); Head := Head^.Next; End; Writeln; End; Function GetNumberOfGap(): Integer; //нахождение выбывающего Var IsCorrect: Boolean; Gap: Integer; Begin Repeat IsCorrect := True; Try Gap := 0; Readln(Gap); Except IsCorrect := False; End; If IsCorrect And (Gap < 2) Then Until IsCorrect; Result := Gap; End; Var Gap, Data, NumberOfPlayers: Integer; Head: TPElem; Begin Write('Введите количество участников: '); Readln(NumberOfPlayers); Write('Введите номер выбывающего: '); Gap := GetNumberOfGap(); Writeln('------------------------------------------'); For Data := 2 To NumberOfPlayers Do Begin Head := CreateRoundList(Data); Writeln('Количество игроков: ', Data, ' '); CountDown(Head, Gap); Writeln('Победитель: ', Head^.Data); Writeln; End; Readln; End.