(************************************************) (* SUICIDAL DIVISION PROBLEM *) (* Maximum Summed Sub-Rectangular-Prism *) (************************************************) Const MaxN = 30; (* Max dimension of input cube *) inPath = 'subprism.in'; outPath = 'subprism.out'; Type Layer = Array[1..MaxN, 0..MaxN] of LongInt; Var TtoB:Array[0..MaxN] of ^Layer; (* TtoB = Top_To_Bottom *) LSum:Layer; (* LSum = Layer_Sum *) Times,Cases,i,j,k,N,T,B,Sum,MaxSum,Temp:LongInt; F,G:Text; Begin Assign(F,inPath); Reset(F); Assign(G,outPath); ReWrite(G); While True Do Begin ReadLn(F, N); (* Size of cube *) If N = -1 then Break; For i:=0 to MaxN do Begin New(TtoB[i]); (* Get memory...*) FillChar(TtoB[i]^,SizeOf(TtoB[i]^),0); End; (* READ INPUT *) For i:=1 to N do For j:=1 to N do For k:=1 to N do Begin (* Sum from top layer to bottom *) Read(F,Temp); TtoB[i]^[j,k]:=TtoB[i-1]^[j,k] + Temp; End; (* Now, we have the input... *) Sum:=0; MaxSum:=-MaxLongInt; For T:=0 to N do (* From Top... *) For B:=T + 1 to N do (* To Bottom... *) Begin (* This makes the correct layer and sums the columns *) FillChar(LSum,SizeOf(LSum),0); For j:=1 to N do For k:=1 to N do LSum[j,k]:=TtoB[B]^[j,k] - TtoB[T]^[j,k] + LSum[j,k-1] + LSum[j,k]; (* Now, find the max-summed rectangle in this layer *) For j:=0 to N do For k:=j + 1 to N do Begin For i:=1 to N do Begin Sum:=Sum + LSum[i,k] - LSum[i,j]; If Sum > MaxSum then MaxSum:=Sum; If Sum < 0 then Sum:=0; End; Sum:=0; (* Reset sum for new rectangle *) End; End; For i:=0 to MaxN do Dispose(TtoB[i]); (* Free memory!!! *) WriteLn(G,MaxSum); End; Close(F); Close(G); End.Downloader failed! Response object 006~ASP 0159~Buffering Off~Buffering must be on.