;
mrg:=umn;
inc(ku)
end;
ru:=umn
end;
if (dmn>=r) and (dmn<=rd) then begin
i:=k; while (mrg>dmn) and (mrg>0) do dec(i);
if mrg<>umn then begin
if mrg<>0 then
for j:=k-kd to i do mrg:=mrg[j+1];
mrg:=dmn;
inc(kd)
end;
rd:=dmn
end;
until rm=cr;
if (ku=1) and (kd=1) then
begin
inc(kilk0);
for rn:=mrg[0] to mrg [k]do
for cn:=lm to rm do
if m[rn,cn]=0 then
begin m[rn,cn]:=2; dec(k0) end;
ee:=0;
repeat
while (m[mzero[ee].r,mzero[ee].c]=0) do inc(ee);
if ee<e then
for j:=ee to e-1 do
mzero:=mzero[j+1];
dec (e)
until ee>=e;
end;
inc(e);
end;
end;

procedure Recurs;
var e,lm,rm,pu,pd: integer;
begin
for e:=0 to length(mzero)-1 do begin
if m[mzero[e].r,mzero[e].c]=0
then begin

for pu:=0 to mzero[e].ku-1 do
for pd:=mzero[e].k downto mzero[e].k-mzero[e].kd+1 do
begin
lm:=mzero[e].c;
while FreeC(lm-1,mzero[e].r,mzero[e].mrg[pu],mzero[e].mrg[pd],umn,dmn)
do dec(lm);
rm:=mzero[e].c;
while FreeC(rm+1,mzero[e].r,mzero[e].mrg[pu],mzero[e].mrg[pd],umn,dmn)
do inc(rm);
inc(kilkist_ruhiv);
for rr:=mzero[e].mrg [pu]to mzero[e].mrg [pd]do
for cc:=lm to rm do
begin
if m[rr,cc] mod 3 = 0 then inc(m[rr,cc],3);
if m[rr,cc] = 3
then begin dec (k0);
if k0 = 0 then
if kilkist_ruhiv<min_kilkist
then min_kilkist:=kilkist_ruhiv
end;
end;
if k0>0 then Recurs;
dec(kilkist_ruhiv);
for rr:=mzero[e].mrg [pu]to mzero[e].mrg [pd]do
for cc:=lm to rm do
begin
if m[rr,cc] mod 3=0 then dec(m[rr,cc],3);
if m[rr,cc] = 0
then inc (k0);
end;
end;
end;
end;
end;

begin
InputData;
kilk0:=0;
PrepareData;
kilkist_ruhiv:=0;
min_kilkist:=k0;
Recurs;
Assign (f,'clear.sol');
ReWrite (f);
writeln (f,min_kilkist+kilk0);
Close (f)
end.