Вітаю Вас, Гость

Задача A
var
  d:array[1..100] of integer;
  n,b,i,p,c:integer;
begin
  readln(n);
  for i:=1 to n do
    readln(d[i]);
  b:=0;
  for i:=1 to n do begin
    p:=i;
    c:=1;
    while (d[p]<>0) do begin
      p:=d[p];
      c:=c+1;
    end;
    if (c>b) then b:=c;
  end;
  writeln(b);
end.

Задача B
#include "iostream"
#include <stdio.h>
#include <math.h>
#include <stdlib.h>
#include <fstream>
#include <time.h>

using namespace std;

char c;
int i,j;

struct rec
{
 char lit;
 int col;
};

rec a[27],t;

void sort()
{
 for(j=1;j<=26;j++)
  for(i=1;i<=26-j;i++)
   if (a[i].col<a[i+1].col)
    {
          t=a[i];
          a[i]=a[i+1];
          a[i+1]=t;
         }
}

void init()
{
 for(i=1;i<=26;i++)
 {
  a[i].lit=(char)(i+64);
 }
}

int main()
{
 ifstream fin;
 ofstream fout;
 fin.open("qwerty.in", ios::in);
 fout.open("qwerty.out", ios::out);
init();
while (!fin.eof())
{
 fin>>c;
 i=(int)toupper(c);
 if ((i>=65 && i<=90)||(i>=97 && i<=122)) {a[i-64].col=a[i-64].col+1;a[i-64].lit=toupper(c);}
}
 if (a[i-64].col>0) a[i-64].col=a[i-64].col-1;
 sort();
  fout<<a[26].lit<<a[21].lit<<a[17].lit<<a[9].lit<<a[11].lit<<a[12].lit;
 fout.close();
}

Задача C
#include "iostream"
#include <stdio.h>
#include <math.h>
#include <stdlib.h>
#include <fstream>
#include <time.h>

using namespace std;

int interval(string a)
{
  int inter=0,G1,G2,X1,X2;
  string g1,g2,x1,x2;
  if (a[0]!='0')g1=a[0];g1=g1+a[1];
  if (a[3]!='0')x1=a[3];x1=x1+a[4];
  if (a[6]!='0')g2=a[6];g2=g2+a[7];
  if (a[9]!='0')x2=a[9];x2=x2+a[10];

  G1=atoi(g1.c_str());
  G2=atoi(g2.c_str());
  X1=atoi(x1.c_str());
  X2=atoi(x2.c_str());

  if(G1>G2) G2=24+G2;

  inter=G2*3600+X2*60-(G1*3600+X1*60);
  return inter;
}

int main()
{
 ifstream fin;
 ofstream fout;
 fin.open("piar.in", ios::in);
 fout.open("piar.out", ios::out);
 long int k,r,v,a[101],sum[101]={0},suma=0,i,t,n=1;
 string s;
 fin>>k>>r>>v;
 for(i=1;i<=k;i++)
 {
  fin>>a[i];
  suma+=a[i];
 }
 for(i=1;i<=r;i++)
 {
  fin>>s;
  t=interval(s);
  while(t>0)
  {
        if (t>=a[n])
         {
          t-=a[n];
          sum[n]=sum[n]+1;
          if(n<k)n++;else n=1;
         }else break;
  }
 }
 for(i=1;i<=k;i++)
  fout<<sum[i]*a[i]*v<<' ';
 fout.close();
}

Задача D
program project1;

type
   element=record
               r,c,ru,rd,cl,cr,k,ku,kd:integer;
               mrg:array of integer;
             end;
var m:array of array of integer;
    mzero:array of element;
    j,kr,kc,k0,kilk0,kilkist_ruhiv,min_kilkist,rr,cc,umn,dmn:integer;
    f:text;

procedure InputData;
var r,c:integer;
begin
  Assign (f,'clear.dat');
  ReSet (f);
  readln (f,kc,kr);
  setlength (m,kr+2,kc+2);
  k0:=0;
  for r:=1 to kr do
  for c:=1 to kc do
  begin
     read (f, m[r,c]);
     if m[r,c]=0 then inc(k0)
  end;
  Close (f);
  for r:=0 to kr+1 do begin
    m[r,0]:=1;m[r,kc+1]:=1;
  end;
  for c:=1 to kc+1 do begin
    m[0,c]:=1; m[kr+1,c]:=1;
  end;
end;

function FreeC (col,r,u,d: integer; var num, ndm: integer):boolean;
var i: integer;
    rez:boolean;
begin
   rez:=true;
   for i:=r downto u do
       if m[i,col]=1 then begin
               rez:=false;
               num:=i+1; break end;
   for i:=r to d do
      if m[i,col]=1 then begin
              rez:=false;
              ndm:=i-1; break end;
   FreeC:=rez
  end;

procedure PrepareData;
var   e,ee,i,rr,cc,lm,rm,rn,cn:integer;
begin
  setlength (mzero,k0);
  e:=0;
  for rr:=1 to kr do
  for cc:=1 to kc do
     if m[rr,cc]=0 then
     with mzero[e] do
     begin
           r:=rr;
           c:=cc;
           ru:=rr; while m[ru-1,cc]<>1 do dec(ru);
           rd:=rr; while m[rd+1,cc]<>1 do inc(rd);
           cl:=cc; while m[rr,cl-1]<>1 do dec(cl);
           cr:=cc; while m[rr,cr+1]<>1 do inc(cr);
           k:=rd-ru+1;
           setlength (mrg,k+1);
           for i:=1 to k do mrg[i]:=0;
           mrg[0]:=ru; ku:=1;
           mrg[k]:=rd; kd:=1;
           lm:=c; umn:=ru; dmn:=rd;
           repeat
              while FreeC(lm-1,r,ru,rd,umn,dmn) do dec(lm);
              if (umn<=r) and (umn<>mrg[ku-1]) then
                 begin ru:=umn; mrg[ku]:=umn; inc(ku) end;
              if (dmn>=r) and (dmn<>mrg[k-kd+1]) then
                 begin rd:=dmn; mrg[k-kd]:=dmn; inc(kd) end;
              until lm=cl;
              rm:=c; umn:=ru; dmn:=rd;
              repeat
                while FreeC(rm+1,r,ru,rd,umn,dmn) do inc(rm);
                if (umn<=r) and (umn>ru) then begin
                  i:=0;
                  while (mrg[i]<umn) and (mrg[i]>0) do inc(i);
                  if mrg[i]<>umn then begin
                                         if mrg[i]<>0 then
                                         for j:=ku downto i do
                                             mrg[j+1]:=mrg[j];
                                         mrg[i]:=umn;
                                         inc(ku)
                                    end;
                  ru:=umn
                end;
                if (dmn>=r) and (dmn<=rd) then begin
                  i:=k; while (mrg[i]>dmn) and (mrg[i]>0) do dec(i);
                  if mrg[i]<>umn then begin
                                         if mrg[i]<>0 then
                                         for j:=k-kd to i do mrg[j]:=mrg[j+1];
                                         mrg[i]:=dmn;
                                         inc(kd)
                                    end;
                  rd:=dmn
                end;
              until rm=cr;
           if (ku=1) and (kd=1) then
           begin
              inc(kilk0);
              for rn:=mrg[0] to mrg[k] do
              for cn:=lm to rm do
                    if m[rn,cn]=0 then
                          begin  m[rn,cn]:=2; dec(k0) end;
               ee:=0;
               repeat
                 while (m[mzero[ee].r,mzero[ee].c]=0) do inc(ee);
                 if ee<e then
                 for j:=ee to e-1 do
                     mzero[j]:=mzero[j+1];
                 dec (e)
               until ee>=e;
           end;
           inc(e);
     end;
end;

procedure Recurs;
var e,lm,rm,pu,pd: integer;
begin
   for e:=0 to length(mzero)-1 do begin
      if m[mzero[e].r,mzero[e].c]=0
      then begin

              for pu:=0 to mzero[e].ku-1 do
              for pd:=mzero[e].k downto mzero[e].k-mzero[e].kd+1 do
              begin
                lm:=mzero[e].c;
                while FreeC(lm-1,mzero[e].r,mzero[e].mrg[pu],mzero[e].mrg[pd],umn,dmn)
                do dec(lm);
                rm:=mzero[e].c;
                while FreeC(rm+1,mzero[e].r,mzero[e].mrg[pu],mzero[e].mrg[pd],umn,dmn)
                do inc(rm);
                inc(kilkist_ruhiv);
                for rr:=mzero[e].mrg[pu] to mzero[e].mrg[pd] do
                for cc:=lm to rm do
                begin
                  if m[rr,cc] mod 3 = 0 then inc(m[rr,cc],3);
                  if m[rr,cc] = 3
                  then begin dec (k0);
                            if k0 = 0 then
                                 if kilkist_ruhiv<min_kilkist
                                 then min_kilkist:=kilkist_ruhiv
                         end;
                end;
                if k0>0 then Recurs;
                dec(kilkist_ruhiv);
                for rr:=mzero[e].mrg[pu] to mzero[e].mrg[pd] do
                for cc:=lm to rm do
                  begin
                    if m[rr,cc] mod 3=0 then dec(m[rr,cc],3);
                    if m[rr,cc] = 0
                    then inc (k0);
                  end;
              end;
           end;
  end;
 end;

begin
  InputData;
  kilk0:=0;
  PrepareData;
  kilkist_ruhiv:=0;
  min_kilkist:=k0;
  Recurs;
  Assign (f,'clear.sol');
  ReWrite (f);
  writeln (f,min_kilkist+kilk0);
  Close (f)
end.