Cele mai bune solutii pentru problema "Acoperire"
(ziua2, problema4)

Punctaj Maxim : 75 puncte

Solutii :
Tanescu Horatiu - Bihor - 75 puncte
Streng Cristian - Bihor - 75 puncte
Dondera Tiberiu - Arges - 75 puncte
Stroe Mihai - Bucuresti - 75 puncte
Grigorescuta Cristian - Botosani - 75 puncte
Tanescu Horatiu - Bihor - 75 puncte
Oprean Mircea - Cluj - 75 puncte
Serafinescu Serban - Galati - 75 puncte
Nica Edison - Iasi - 75 puncte
Musaloiu Elefteri Razvan - Constanta - 75 puncte
Andronic Ovidiu - Neamt - 75 puncte
Szasz Janos - Covasna - 75 puncte
Luca Faro Bogdan - Braila- 75 puncte
Arba Mihai - Maramures - 75 puncte
Prodan Victor - Galati - 75 puncte
Monea Adrian - Cluj - 75 puncte
Ivan Cristian - Dambovita- 75 puncte
Dumitrescu Bogdan - Bucuresti - 75 puncte
Muloiu Elefteri Raluca - Constanta- 75 puncte
Boboc Sergiu - Olt - 75 puncte
Zaharia Adrian - Teleorman - 75 puncte
Platon Adrian - Salaj - 75 puncte
Floricica Radu - Mehedinti - 75 puncte
Comisia Centrala
Fisierele de teste

Program realizat de elevul Tanescu Horatiu - rezultat final : premiu II - 153 puncte

{$R-}

const
  InStr : string = 'input.txt';
  OutStr : string = 'output.txt';

type
  PGrid = ^TGrid;
  TGrid = array[1..255, 1..255] of Boolean;

var
  M, N, P, MaxX, MaxY, MaxCount, SolX, SolY : Integer;
  Grid : PGrid;

  HorizMax : array[0..255] of Integer;

procedure ReadInputData;
var
  F : Text;
  I, X, Y : Integer;
begin
  GetMem(Grid, SizeOf(TGrid));

  FillChar(Grid^, SizeOf(TGrid), 0);
  FillChar(HorizMax, SizeOf(HorizMax), 0);
  MaxX := 0;
  MaxY := 0;
  SolX := 0;
  SolY := 0;
  MaxCount := 0;

  Assign(F, InStr);
  Reset(F);
  ReadLn(F, M, N);
  ReadLn(F, P);
  for I := 1 to P do
  begin
    ReadLn(F, X, Y);
    Grid^[X, Y] := True;
    if X > MaxX then MaxX := X;
    if MaxX + M > 255 then MaxX := 255 - M;
    if Y > MaxY then MaxY := Y;
    if MaxY + N > 255 then MaxY := 255 - N;
  end;
  Close(F);
end;

procedure WriteOutputData;
var
  F : Text;
  X, Y : Integer;
begin
  Assign(F, OutStr);
  Rewrite(F);
  WriteLn(F, MaxCount);
  WriteLn(F, SolX, ' ', SolY);

  for X := SolX to SolX + M do
    for Y := SolY to SolY + N do
      if (X <> 0) and (Y <> 0) then
        if Grid^[X, Y] then WriteLn(F, X, ' ', Y);

  Close(F);
end;

procedure CheckMax(Count, X, Y : Integer);
begin
  if Count > MaxCount then
  begin
    MaxCount := Count;
    SolX := X;
    SolY := Y;
  end;
end;

procedure Solve;
var
  X, Y, XX, Count : Integer;
begin

  { 0, 0 rectangle }
  Count := 0;
  for X := 1 to M do
    for Y := 1 to N do
      if Grid^[X, Y] then Inc(Count);
  HorizMax[0] := Count;
  CheckMax(HorizMax[0], 0, 0);

  { X, 0 rectangles }
  for X := 1 to MaxX do
  begin
    Count := 0;
    for Y := 1 to N do
    begin
      if Grid^[X + M, Y] then Inc(Count);
      if X > 1 then
        if Grid^[X - 1, Y] then Dec(Count);
    end;
    HorizMax[X] := HorizMax[X - 1] + Count;
    CheckMax(HorizMax[X], X, 0);
  end;

  { X, Y rectangles }
  for Y := 1 to MaxY do
  begin
    for X := 0 to MaxX do
    begin
      Count := 0;
      for XX := X to X + M do
      begin
        if XX = 0 then Continue;
        if Grid^[XX, Y + N] then Inc(Count);
        if Y > 1 then if Grid^[XX, Y - 1] then Dec(Count);
      end;
      HorizMax[X] := HorizMax[X] + Count;
      CheckMax(HorizMax[X], X, Y);
    end;
  end;
end;

begin
  ReadInputData;
  Solve;
  WriteOutputData;
  FreeMem(Grid, SizeOf(TGrid));
end.

[BACK]

Program realizat de Comisia Centrala a Olimpiadei Nationale de Informatica

[BACK]

Fisierele de teste :

[BACK]