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.