Разбор задач

1. Черно-белая графика

var
  p1,p2:array[1..100]of string; { Изображения }
  op:string; { Логическая операция }
  w,h,i,j:integer; { Размеры и переменные цикла }
...
{Ввод}
  for i:=1 to h do
    readln(p1[i]);
  for i:=1 to h do
    readln(p2[i]);
  readln(op);

  for i:=1 to h do
  begin
    for j:=1 to w do
      write(op[(ord(p1[i][j])-ord('0'))*2+(ord(p2[i][j])-ord('0'))+1]);
    writeln;
  end;

2. Газон

var res:int64; { ответ может быть больше, чем 2*10^9 }
...
  res:=0;
  for x:=max(x1,x3-r) to min(x2,x3+r) do
  begin
    d:=trunc(sqrt(sqr(extended(r))-sqr(extended(x3-x))));
    ymin:=max(y1,y3-d);
    ymax:=min(y2,y3+d);
    if ymin<=ymax then
      res:=res+ymax-ymin+1;
  end;

3. Трамвай

var sumtree:array[1..4194303] of longint;
...
  k:=pass[j].a-pass[j].b+2097152;
  if pass[j].c=i then 
    inc(sumtree[k]) { пассажир вошел }
  else
    dec(sumtree[k]); { пассажир вышел }
  { восстанавливаем корректность дерева }
  while k>1 do
  begin
    k:=k div 2;
    sumtree[k]:=sumtree[2*k]+sumtree[2*k+1];
  end;

  if sumtree[1] < m then
    difm:=0 { пассажиров с положительной разностью меньше m }
  else
  begin
    k:=1;
    mm:=m;
    while k<2097152 do
    begin
      k:=2*k+1; { переходим к правому потомку узла }
      if sumtree[k]<mm then 
      begin { в правом потомке менее mm пассажиров }
        mm:=mm-sumtree[k];
        dec(k); { выбираем левого потомка }
      end;
    end;
    difm:=k-2097152;
  end;

  if pass[j].c=i then
  begin { пассажир вошел }
    if oldifm<pass[j].a-pass[j].b then { занял чье-то место }
      sumd:=sumd+pass[j].a-pass[j].b-oldifm
  end
  else
  begin { пассажир вышел }
    if difm<pass[j].a-pass[j].b then { на его место кто-то сел }
       sumd:=sumd-(pass[j].a-pass[j].b)+difm;
  end;
  oldifm:=difm;

var
  sl:array [1..100001] of integer; { номера первых пассажиров в спиcках }
  pass:array [1..100000] of record
    a,b,c,d:longint;
    nextin,nextout:longint; { номер следующего в списке }
  end;
...
{ Ввод и распределение по спискам }
  readln(N,M,S);
  for i:=1 to N do
  begin
    readln(pass[i].a,pass[i].b,pass[i].c,pass[i].d);
    pass[i].nextin:=sl[pass[i].c];
    sl[pass[i].c]:=i;
    pass[i].nextout:=sl[pass[i].d];
    sl[pass[i].d]:=i;
  end;

  res:=0;
  sumd:=0; { сумма разностей у сидящих }
  sumb:=0; { сумма b[i] у всех пассажиров трамвая }
  oldifm:=0;
  for i:=1 to S do
  begin
    j:=sl[i]; { индекс первого пассажира, 
                вошедшего или вышедшего на i-ой остановке }
    while j<>0 do { список не закончился }
    begin
      if pass[j].a>pass[j].b then
      begin
        { модифицируем дерево сумм }
        ...
        { пересчитываем сумму разностей сидящих пассажиров }
        ...
      end;
      if pass[j].c=i then
      begin { пассажир вошел }
        sumb:=sumb+pass[j].b
        j:=pass[j].nextin; { к следующему в списке }
      end
      else
      begin { пассажир вышел }
        sumb:=sumb-pass[j].b;
        j:=pass[j].nextout; { к следующему в списке }
      end;
    end;
    res:=res+sumd+sumb; 
  end;
  writeln(res);

4. Треугольники

var N,i,j,k,m,jj:longint;
  x,y:array[1..1500] of longint;
  d:array[1..1500] of record d:int64;x,y:longint; end;;
  res:int64;
...
  { ввод данных }
  readln(N);
  for i:=1 to N do
    readln(x[i],y[i]);
  res:=0;
  for i:=1 to N do
  begin
    { заполняем массив с расстояниями и относительными координатами }
    k:=0;
    for j:=1 to N do
      if i<>j then
      begin
        inc(k);
        d[k].d:=sqr(int64(x[i]-x[j]))+sqr(int64(y[i]-y[j]));
        d[k].x:=x[j]-x[i];
        d[k].y:=y[j]-y[i];
      end;
    { сортировка }
    qsort(1,k);
    j:=1;
    while j<=k do
    begin
      { считаем количество точек на одинаковом расстоянии }
      m:=1;
      while (j+m<=k) and (d[j].d=d[j+m].d) do
      begin
        { вычитаем вырожденные треугольники }
        for jj:=j to j+m-1 do
          if (d[j+m].x=-d[jj].x) and (d[j+m].y=-d[jj].y) then
            dec(res);
        inc(m);
      end;
      res:=res+m*(m-1) div 2;
      j:=j+m;
    end;
  end;
  writeln(res);

5. Клавиатура

6. Неправильное сложение

function sum(s1,s2:string):string;
var r:string;
  i,p:integer;
begin
  {выравниваем числа по длине }
  while length(s1)<length(s2) do s1:='0'+s1;
  while length(s1)>length(s2) do s2:='0'+s2;
  { складываем }
  r:='';
  for i:=length(s1) downto 1 do
  begin
    p:=ord(s1[i])+ord(s2[i])-2*ord('0');
    r:=chr(p mod 10+ord('0'))+r;
    if p>=10 then
      r:='1'+r; 
  end;
  sum:=r;
end;

7. Числа

var
  c,n,k,v,i,j:longint;
  s:string;
  t:array[0..50000] of int64;
  p:int64;
...
  readln(n,c,k);
  readln(s);
  { вычисляем 10^k }
  p:=1;
  for i:=1 to k do
    p:=p*10;
  { основной цикл: заполнение таблицы }
  t[0]:=1;
  for i:=1 to n do
  begin
    v:=0;
    for j:=i to n do
    begin 
      { увеличиваем значения всех ячеек, достижимых с позиции i }
      v:=v*10+ord(s[j])-ord('0');
      if v>c then break;  
      t[j]:=(t[j]+t[i-1]) mod p;
      if s[i]='0' then break; { c 0 достижима только следующая ячейка }
    end;
  end;
  writeln(t[n]);

8. Перестановки

function gcd(a,b:longint):longint;
begin
  if b=0 then gcd:=a
  else gcd:=gcd(b, a mod b);
end;

var
  _gcd:array[1..16,1..16]of longint;
...
  for i:=1 to n do
    for j:=1 to n do
      _gcd[i,j]:=gcd(p[i],p[j]);

var
  c:array[1..16,1..65535]of int64; { таблица с результатами подзадач }
...
function count(i,mask:longint):int64;
var j:longint;
begin
  if c[i,mask]<0 then { значение еще не вычислялось }
  begin
    c[i,mask]:=0;
    for j:=1 to n do
      if (i<>j) and 
          ((mask and (1 shl (j-1)))<>0) and { есть в подмножестве }
          (_gcd[i,j]>=k) { НОД > k }
      then 
        { j-й элемент можно поставить следующим после i-го }
        c[i,mask]:=c[i,mask]+count(j,mask and not(1 shl (i-1)));
  end;
  count:=c[i,mask];
end;
...
  { начальная заполнение таблицы }
  mask:=(1 shl n)-1;
  for i:=1 to n do
    for j:=1 to mask do
      c[i,j]:=-1; { вычисления не выполнены }
  for i:=1 to n do
    c[i,1 shl (i-1)]:=1; { существует только одна перестановка из одного элемента }

var
  p:array[1..16]of longint;
  n,m,k,t,i,j,mask:longint;
...
  read(n,m,k);
  for i:=1 to n do
    read(p[i]);
  for i:=1 to n do
    for j:=i+1 to n do
      if p[i]>p[j] then
      begin
        t:=p[i];
        p[i]:=p[j];
        p[j]:=t;
      end;

var fl:boolean;
...
  i:=0; { предыдущий элемент перестановки }
  while mask<>0 do { пока не выведем все элементы из множества }
  begin
    fl:=false;
    for j:=1 to n do
    begin
      if (i<>j) and 
       ((mask and (1 shl (j-1)))<>0) and { есть в подмножестве }
       ((i=0) or (_gcd[i][j]>=k)) { НОД > k или 1 элемент перестановки }
      then
      begin
        if m<=count(j,mask) then 
        begin { попали на нужный элемент }
          write(p[j],' ');
          i:=j;
          mask:=mask and not(1 shl (j-1));
          fl:=true;
          break;
        end
        else
          m:=m-count(j,mask);
      end;
    end;
    if not fl then { нет подходящего элемента }
    begin
      writeln(-1);
      halt(0);
    end;
  end;
  writeln;