1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
| const v=5;
minX=1;
minY=1;
maxX=90;
maxY=90;
t=1;
type
Tns=class(TObject)
m:array [1..v,minX..maxX,minY..maxY] of Byte;
p:array [1..v,minX..maxX,minY..maxY] of Byte;
Power:array[1..v] of Real;
education:Boolean;
name:string[255];
function Solve:Real;
procedure save(i:Byte);
procedure load(i:Byte);
end;
procedure Tns.load;
var z,x,y:Byte; f:file of Byte;
begin
AssignFile(f,ExtractFileDir(ParamStr(0))+'\'+name+' '+inttostr(i)+'.NeN');
{$I-}
Reset(f);
if IOResult=0 then begin
for z:=1 to v do for x:=minX to maxX do for y:=minY to maxY do read(f,m[z,x,y]);
CloseFile(f);
end;
end;
procedure Tns.save(i:Byte);
var z,x,y:Byte; f:file of Byte;
begin
AssignFile(f,ExtractFileDir(ParamStr(0))+'\'+name+' '+inttostr(i)+'.NeN');
Rewrite(f);
for z:=1 to v do for x:=minX to maxX do for y:=minY to maxY do write(f,m[z,x,y]);
CloseFile(f);
end;
function Tns.Solve: Real;
var z,x,y:Byte; x1,y1:Shortint;
begin
//Очищаем потенциал
for z:=2 to v do for x:=minX to maxX do for y:=minY to maxY do p[z,x,y]:=0;
//поднимаемся вверх по трехмерному массиву
for z:=1 to v-1 do begin
for x:=minX to maxX do for y:=minY to maxY do if (p[z,x,y]=m[z,x,y]) then begin
for x1:=-t to t do for y1:=-t to t do p[z+1,x+x1,y+y1]:=1;
if education then m[z+1,x,y]:=p[z+1,x,y];
end;
end;
if education then education:=False;
//Собараем результат
for z:=1 to v do Power[z]:=0;
for z:=1 to v do for x:=minX to maxX do for y:=minY to maxY do if p[z,x,y]=0 then Power[z]:=Power[z]+1;
Result:=Power[v];
end; |
(
