uses crt;
var
  i, d: integer;
  s: string;
begin
  clrscr;
  write('Input text: ');
  readln(s);
  i:=1;
  while (s[i]<>'!') do
  begin
    if (s[i] in ['А'..'Я']) then
    begin
       d:=ORD(s[i])-ORD('А');
       delete(s,i,1);
       insert(CHR(ORD('а')+d),s,i);
    end;
    inc(i);
  end;
  write(s);
  readln;
end.

const
  n = 5;
  m = 4;

var
  A: array [1..n,1..m] of real;
  i, j : integer;
  max: real;

begin
  randomize;
  max:=0;
  writeln('Source matrix');
  for i:=1 to n do
  begin
    for j:=1 to m do
    begin
      A[i,j]:=(random(200)-100)/20;
      write(A[i,j]:4:2,' ');
      if abs(A[i,j]) > max then
        max := abs(A[i,j]);
    end;
    writeln;
  end;
  writeln;
  writeln('Max = ',max:4:2);
  writeln('New matrix');

  for i:=1 to n do
  begin
    for j:=1 to m do
    begin
      A[i,j]:=A[i,j]/max;
      write(A[i,j]:4:2,' ');
    end;
    writeln;
  end;
  readln;

end.

type
  TInt = 1..9;

var
  str: string;
  evens: set of TInt;
  i, cntr: integer;

begin
  for i:=2 to 8 do
    if (i mod 2) = 0 then
      evens := evens + [i];

  write('Yuor string: ');
  readln(str);

  cntr:=0;
  for i:=1 to Length(str) do
    if (ORD(str[i])-48) in evens then
      inc(cntr);

  write('Count of even numbers is ',cntr);

  readln;

end.

uses crt;

type
   TData = record
           number: word;
           weight: real;
          end;
   PComp=^Comp;
   Comp=record
         D : TData;
         pNext, PPrevious :PComp
        end;
var
   p1Begin, p2Begin : PComp;
   DetailCount, i: word;
   ScreeningWeight: real;
   Data: TData;

procedure Add(Var beg : PComp; Data : TData);
var
  tmp: PComp;
begin
   New(tmp);
   tmp^.D:=Data;
   if beg = nil then
   begin
     tmp^.pNext := tmp;
     tmp^.PPrevious := tmp;
     beg:=tmp;
   end
   else
   begin
     tmp^.pNext := beg;
     tmp^.PPrevious := beg^.PPrevious;
     beg^.PPrevious^.pNext:=tmp;
     beg^.PPrevious:=tmp;
   end;
end;

procedure Extract(Var beg : PComp; var Data : TData);
var
  tmp: PComp;
begin
  Data:=beg^.D;
  if beg^.PPrevious = beg then
  begin
    dispose(beg);
    beg:=nil;
  end
  else
  begin
    tmp:=beg;
    beg:=beg^.pNext;
    beg^.PPrevious := tmp^.PPrevious;
    dispose(tmp);
  end;
end;

begin
  clrscr;
  write('Input detail count: ');
  readln(DetailCount);
  write('Input screening weight: ');
  readln(ScreeningWeight);
  randomize;
  i:=1;

  // fill main line
  writeln('The main line (n - number, w - weight):');
  while i<=DetailCount do
  begin
    Data.number:=i;
    Data.weight:=random(100)/20;
    Add(p1Begin,Data);
    writeln('n ',Data.number:2,' w ',Data.weight:3:1,'; ');
    inc(i);
  end;

  // fill ancillary line & output results
  writeln('The ancillary line (n - number, w - weight):');
  while p1Begin<>nil do
  begin
    Extract(p1Begin,Data);
    if Data.weight>=ScreeningWeight then
    begin
       Add(p2Begin,Data);
       writeln('n ',Data.number:2,' w ',Data.weight:3:1,'; ');
    end;
  end;

  // clear ancillary line
  while p2Begin<>nil do
  begin
    Extract(p2Begin,Data);
  end;
  readln;
end.

var
  A: array [1..50,1..50] of real;
  i, j, n : integer;
  s1, s2: real;
begin
  write('n = ');
  readln(n);
  writeln('A:');
  s1:=0;
  s2:=0;
  randomize;
  for i:=1 to n do
  begin
    for j:=1 to n do
    begin
      A[i,j]:=(random(100)-50)/20;
      if i=j then
        s1:=s1+A[i,j]
      else if i=(n-j+1)then
        s2:=s2+A[i,j];
      write(A[i,j]:4:2,' ');
    end;
    writeln;
  end;

  writeln('s1 = ',s1:5:2);
  writeln('s2 = ',s2:5:2);
  readln;
end.

Program Ex14;
uses crt;

var
  i : integer;
  x : real;

function f(x: real; n: integer): real;
var
  k: integer;
  s: real;
begin
  s:=0;
  for k:=1 to n do
   s:=s+sqrt(exp(-k*x)+exp((abs(k-1))*ln(x)))/cos(k*x)+sin(k*x);
  f:=s+Ln(abs(n*x-1));
end;

begin
  clrscr;
  writeln('┌───────┬───────┬───────────┐');
  writeln('│   n   │   x   │     f     │');
  writeln('├───────┼───────┼───────────┤');
  for i:=10 to 15 do
  begin
    x:=0.6;
    repeat
      writeln('│  ',  i,'   │  ',x:3:2,' │',f(x,i):10:5,' │');
      if (x=1.1) and (i=15) then writeln('└───────┴───────┴───────────┘')
      else
      writeln('├───────┼───────┼───────────┤');
      x:=x+0.25;
    until x>1.1;
  end;
  readln;
end.

program Den_of_Day;
uses Crt;
 var
   IsCorrectDate:boolean;
   d,m,y:integer;
Procedure InputDate(var d,m,y:integer; var correctly:boolean);
 begin
   Writeln('Введите дату в формате ДД ММ ГГГГ');
   readln(d,m,y);
   correctly:= (d>=1) and (d<=31) and (m>=1) and (m<=12) and (y>1581) and (y<4902)
 end;
Procedure WriteDay(d,m,y:integer);
const
   Day:array [0..6] of string [11] = ('Воскресение','Понедельник','Вторник','Среда' ,'Четверг','Пятница','Суббота');
var
   c,w:integer;
begin
  if m<3 then
      begin
        m:= m + 10;
        y:= y - 1
      end
  else
   m:= m - 2;
   c:= y div 100;
   y:= y mod 100;
   w:=abs(trunc(2.6*m-0.2)+d+y div 4+y+c div 4-2*c) mod 7;
   writeln(Day[w])
end;
begin
textbackground(8);
clrscr;
textcolor(4);
repeat
   InputDate(d,m,y,IsCorrectDate);
   if IscorrectDate then
       WriteDay(d,m,y)
until not IsCorrectDate
end.

Program Koordinaty;
Uses Crt;
var x,y:byte;
begin
clrscr;
writeln('Vvedite koordinaty');
readln(x,y);
GotoXY(x-1,y);
write('*');
readkey;
end.

Program Povtor;
Uses Crt;
var s,t:string; i,j:integer; b:boolean;
begin
clrscr;
readln(s);
i:=3; b:=true;
while (i<length(s)) and (b) do
     if (s[1]=s[i]) and (s[2]=s[i+1]) then b:=false
     else inc(i);
if i<(length(s)-1) then
begin
     j:=1; t:='';
     while j<i do
     begin
          t:=t+s[j];
          inc(j);
     end;
     writeln('Povorenie - '+t);
end
else writeln('Povtoreniy net');
readkey;
end.