2

program Project2;

{$APPTYPE CONSOLE}

uses
  SysUtils;

const max=100;
type
  vector=array [1..max] of integer;
  matr=array [1..max,1..max] of integer;
  RealVector=array [1..max] of real;
  RealMatr=array [1..max,1..max] of real;

function sum (x: matr; n,l,l2: integer): word;
var i,j,k: integer;
begin
  k:=0;
  for i:=1 to l do
    for j:=1 to l2 do
      if x[i,j]=n then inc(k);
  result:=k;
end;

function find (x: vector; n,w: integer): boolean;
var i: integer;
begin
  result:=false;
  for i:=1 to w do
    if x[i]=n then
     begin
      result:=true;
      break;
    end;
end;
procedure Task;
var
  p,p1: real;
  och,och2,y: vector;
  ym: matr;
  Icount: real;
  yp: RealVector;
  Pij: RealMatr;
  i,l,l2,j,w: integer;
  r: real;
begin
  //l:=6;

  write ('Figura1 count gran: ');
  readln (l);
  p:=1/l;
  writeln ('Ochki 1: ');
   for i := 1 to l do   readln (och[i]);

  write ('Figura2 count gran: ');
  readln (l2);
  writeln ('Ochki 2: ');
   for i := 1 to l2 do  readln (och2[i]);

  w:=0;
  for i:=1 to l do
    for j:=1 to l2 do
      begin
        ym[i,j]:=och[i]+och2[j];
        if not (find(y,ym[i,j],w)) then
        begin
           inc(w);
           y[w]:=ym[i,j];
        end
     end;

  writeln ('X1/X2');

  for i := 1 to l do
    begin
      for j := 1 to l2 do
        write (ym[i,j]:3,' ');
      writeln;
    end;
  p1:=p*p;
  r:=0;

  for i:=1 to w do
   begin
     yp[i]:=sum(ym,y[i],l,l2)*p1;
     r:=r+yp[i];
    end;

  for i := 1 to l do
    for j := 1 to w do
      if ((y[j]-och[i])>=1)and((y[j]-och[i])<=l) then
        Pij[i,j]:=p1
      else Pij[i,j]:=0;

  writeln ('Y/X1=');
  for i := 1 to l do
   begin
     for j := 1 to w do
       write (Pij[i,j]:3:3,' ');
     writeln;
   end;

  Icount:=0;
  for i := 1 to l do
    for j := 1 to w do
     begin
      if Pij[i,j]<>0 then
       begin
        r:=ln(Pij[i,j]/(p*yp[j]))/ln(2);
        Icount:=Icount+ Pij[i,j]*r;
       end;
      end;

  writeln ('Inf count (X1,Y)=',Icount:3:3);
  Icount:=0;
  for i := 1 to l do
    for j := 1 to w do
     begin
      if Pij[i,j]<>0 then
       begin
        r:= (ln(Pij[i,j])/ln(2))-ln(yp[j])/ln(2)-ln(p)/ln(2);
        Icount:=Icount+ Pij[i,j]*r;
       end;
     end;

  writeln ('Inf count I(x1,y)',Icount:3:3);
  for i := 1 to l2 do
    for j := 1 to w+1 do
      if ((y[j]-och2[i])>=1)and((y[j]-och2[i])<=l2) then  Pij[i,j]:=p1
     else Pij[i,j]:=0;

  writeln ('Y/X2=');
  for i := 1 to l2 do
   begin
    for j := 1 to  w do
      write (Pij[i,j]:3:3,' ');
    writeln;
   end;

  Icount:=0;
  for i := 1 to l2 do
    for j := 1 to  w do
    begin
      if Pij[i,j]<>0 then
      begin
        r:=ln(Pij[i,j]/(p*yp[j]))/ln(2);
        Icount:=Icount+ Pij[i,j]*r;
      end;
    end;

  writeln ('Inf count (X2,Y)=',Icount:3:3);
  Icount:=0;
  for i := 1 to l2 do
    for j := 1 to w do
    begin
      if Pij[i,j]<>0 then
      begin
        r:= (ln(Pij[i,j])/ln(2))-ln(yp[j])/ln(2)-ln(p)/ln(2);
        Icount:=Icount+ Pij[i,j]*r;
      end;
    end;
  writeln ('Inf count I(x2,y)=',Icount:3:3);
end;

begin
    { TODO -oUser -cConsole Main : Insert code here }
  Task;
  readln;
 
end.