uses crt;

function CompareRtWrd(word1, word2: string):boolean;
var
  i, j : integer;
  IsRepeat, Ident : boolean;
begin
  Ident:=true;
  CompareRtWrd:=false;
  if Length(Word1) <> Length(Word2) then
    Exit;
  if Word1 = Word2 then
    Exit;

  for i:=1 to Length(Word1) do
  begin
    IsRepeat:=false;
    for j:=1 to Length(Word1) do
      if Word1[i] = Word2[j] then IsRepeat:=true;
    if not IsRepeat then Ident:=false;
  end;

  CompareRtWrd := Ident;

end;

var
  SourceStr : string;
  words: array [1..100] of string;
  i, j, WordsCount : integer;
  IsRtWords: boolean;
begin
  clrscr;
  write('Ваш текст: ');
  readln(SourceStr);
  WordsCount:=1;
  for i:=1 to Length(SourceStr) do
  begin
    if SourceStr[i] in [' ',',','.'] then
       Continue
    else
    begin
      if SourceStr[i-1] in [' ',',','.'] then
         inc(WordsCount);
      words[WordsCount]:=words[WordsCount]+SourceStr[i];
    end;
  end;

  Write('Слова-близнецы в этом предложении ');
  IsRtWords:=false;
  for i:=1 to WordsCount-1 do
    for j:=i+1 to WordsCount do
    begin
      if CompareRtWrd(Words[i],Words[j]) then
      begin
        if not IsRtWords then write(': ')
        else writeln(', ');
        write(' ',Words[i],' и ',Words[j]);
        IsRtWords:=true;
      end;
    end;

    if not IsRtWords then
      Write('не найдены.');

  readln;
end.

uses crt;

function CalcNum(n, k: integer): integer;
var
  i, ElCount, DcEl : integer;
  A: array [1..1000] of byte;
begin
  for i := 1 to n do
    A[i] := i;
  ElCount := n;

  repeat
    if k <= ElCount then DcEl := k
    else if (k mod ElCount) = 0 then DcEl:=ElCount
    else
    begin
      DcEl := (k mod ElCount);
    end;

   {..... test .....}
   write('[');
   TextColor(white);
   for i:=1 to ElCount do
   begin
     if i=DcEl then TextColor(12)
     else TextColor(white);
     write(' ',A[i],' ');
   end;
   TextColor(white);
   writeln(']');
   {.... -test- ....}

    for i := DcEl to ElCount-1 do
      A[i]:=A[i+1];

    ElCount := ElCount - 1;

  until ElCount <= 1;

  CalcNum := A[1];

end;

var
  n, k, num : integer;
begin
  clrscr;
  write('Введите n: ');
  readln(n);
  write('Введите k: ');
  readln(k);
  TextColor(white);
  num := CalcNum(n,k);
  write('Номер оставшегося человека в первоначальном круге ',num);
  readln;
end.

Program MASS;
Uses CRT;
var
a,b: array [1..20, 1..20] of integer;
A1,B1:integer;
min,max,t,y,i,j,n,m,r,s,z:integer;
BEGIN
CLRSCR;
R:=0;
S:=0;
Writeln ('Vvedite razmer massiva A:');
Write ('A:=');
Read (A1);
Writeln ('2x Massiv A:'); writeln;
RANDOMIZE;
FOR i:=1 TO A1 DO
BEGIN
FOR j:=1 TO A1 DO
BEGIN
A[i,j]:=Random (50);
write (A[i,j]:3);
write; END;
Writeln; Writeln;
END;
FOR i:=1 TO A1 DO
BEGIN
FOR j:=1  TO A1 DO
IF a[i,j]<>0 THEN
R:=R+1;
END;
IF r<>0 THEN
writeln ('Kol-vo elementov ne ravnix 0:', R);
IF r=0 THEN
writeln ('Kol-vo elementov ne ravnix 0 HET');
writeln;
Writeln ('Vvedite razmer massiva B:');
Write ('B:=');
Read (B1);
Writeln ('2x Massiv B:');
RANDOMIZE;
FOR n:=1 TO B1 DO
BEGIN
Writeln;
FOR m:=1 TO B1 DO
BEGIN
B[n,m]:=Random (50);
write (B[n,m]:3);
write;
END;
Writeln; Writeln;
END;
FOR n:=1 TO B1 DO
FOR m:=1 TO B1 DO
BEGIN
Y:=B[n,m] MOD 2;
IF Y=0 THEN S:=S+B[n,m];
END;
Writeln ('Vivod summu: ',S);
Writeln;
T:=R MOD 2;
IF T=0 THEN  BEGIN
MIN:= A[i,j];
FOR i:=1 TO A1 DO
BEGIN
FOR j:=1 TO A1 DO
IF a[i,j]<min THEN
MIN:=A[i,j];
END; END;
IF T=0 THEN
writeln ('Minimalnoe znachenie massiva A: ',min);
T:=R MOD 2;
IF T=1 THEN
max:= B[n,m];
FOR n:=1 TO B1 DO
Begin
FOR m:=1 To B1 DO
IF B[n,m]>=max THEN
max:=B[n,m];
END;
IF T<>0 THEN
writeln ('Maximalnoe znachenie massiva B:',max);
readkey
END.

uses crt;
const
  NumbersCount = 15;
  FileName = 'numbers.int';

var
  Numbers : array [1..NumbersCount] of integer;
  i, MaxIndex : integer;

function FileExists(FileName: String): Boolean;
var
  F: file;
begin
  {$I-}
  Assign(F, FileName);
  Reset(F);
  Close(F);
  {$I+}
  FileExists := (IOResult = 0) and (FileName <> '');
end;

procedure WriteFile(FileName: string);
var
  fl  : file of integer;
  i, num: integer;
begin
  Assign(fl,FileName);
  rewrite(fl);
  for i := 1 to NumbersCount do
  begin
    num:=random(100)-50;
    write(fl,num);
  end;
  Close(fl);
end;

function ReadFromFile(FileName: string): boolean;
var
  fl  : file of integer;
  i : integer;
begin
  if FileExists(FileName) then
  begin
    Assign(fl,FileName);
    Reset(fl);
    i:=1;
    while not EOF(fl) do
    begin
      read(fl,Numbers[i]);
      inc(i);
    end;
    ReadFromFile := true;
  end
  else ReadFromFile := false;
end;

function FindMax: integer;
var
  i, max, index: integer;
begin
  max := Numbers[1];
  index := 1;
  for i := 2 to NumbersCount do
    if Numbers[i] > max then
    begin
      max := Numbers[i];
      index := i;
    end;
  FindMax := index;
end;

function CalcSumm(MaxIndex: integer): integer;
var
  i, summ: integer;
begin
  summ:=0;
  for i:= 1 to MaxIndex do
    if Numbers[i] > 0 then
       summ := summ + Numbers[i];
  CalcSumm := summ;
end;

begin
  clrscr;
  randomize;
  WriteFile(FileName);
  if ReadFromFile(FileName) then
  begin
    writeln('Numbers from file (',NumbersCount,'):');
    for i := 1 to NumbersCount do
      write(Numbers[i],'; ');
    writeln;
    MaxIndex := FindMax;
    writeln('MaxIndex = ',MaxIndex);
    writeln('Summa = ',CalcSumm(MaxIndex));
  end
  else writeln('File ',FileName,' not found');
  readln;
end.