Cod sursa(job #26665)

Utilizator vladcyb1Vlad Berteanu vladcyb1 Data 5 martie 2007 20:14:41
Problema Zone Scor 90
Compilator fpc Status done
Runda Arhiva de probleme Marime 5.71 kb

  const
       FIN = 'zone.in';
       FOUT = 'zone.out';
       NMAX = 512;

  type
      matrix = array[ 0..NMAX, 0..NMAX ] of Qword;

  var
      A : matrix;
      S : array[ 1..9 ] of Qword;
      sel : array[ 1..9 ] of integer;
      f, g : text;
      N, L1, L2, C1, C2, poz, L1s, L2s, C1s, C2s, p, pp : longint;
      sum : qword;
      first : boolean;

  procedure read_data;
   var i, j : longint;
   begin
    assign( f, FIN ); reset( f ); readln( f, N );
    for i := 1 to 9 do read( f, S[i] );
    for i := 1 to N do
     for j := 1 to N do read( f, A[i,j] );
     close( f );

    // compute
    for i := 1 to N do
      begin
        sum := 0;
        for j := 1 to N do
          begin
             sum := sum + A[i,j];
             A[i,j] := A[ i - 1, j ] + sum;
           end;
       end;
   end;

  function return( x, y, x1, y1 : longint ) : qword;
    begin
      return := A[ x1, y1 ] - A[ x1, y - 1 ] - A[ x - 1, y1 ] + A[ x - 1, y - 1 ];
    end;

 procedure binary_linie( c1, st, dr, p : longint );
  var juma : longint;
  begin
    if st = dr then
                     begin
                         if A[ L1, st ] - A[ L1, c1 ] = S[ p ] then poz := st
                                                              else poz := -1;
                      end
               else
   begin
      juma := ( st + dr ) shr 1;
      if A[ L1, juma ] - A[ L1, c1 ] < S[p] then binary_linie( c1, juma + 1, dr, p )
                                           else binary_linie( c1, st, juma, p );
  end;
  end;

 procedure binary_col( L1, c1, c2, st, dr, p : longint );
  var juma : longint;
  begin
   if st = dr then
                  begin
                    if return( L1, C1, st, C2 ) = S[p] then poz := st
                                                       else poz := - 1;
                  end
              else
    begin
      juma := ( st + dr ) shr 1;
      if return( L1, C1, juma, C2 ) < S[p] then binary_col( L1, c1, c2, juma + 1, dr, p )
                                           else binary_col( L1, c1, c2, st, juma, p );
   end;
  end;


  function cauta( vv : qword ) : boolean;
   var i : longint;
   begin
    for i := 1 to 9 do
     if ( sel[i] = 0 ) and ( s[i] = vv ) then begin sel[i] := 1; cauta := true; exit; end;
   cauta := false;
  end;

  procedure solutie( L1, L2, C1, C2 : longint );
   begin
    if first then begin first := false; L1s := L1; L2s := L2; C1s := C1; C2s := C2; end else
    begin
      if l1 < l1s then begin L1s := L1; L2s:= L2; C1s := C1; C2s := C2; end else
      if l1 = l1s then
      if c1 < c1s then begin L1s := L1; L2s := L2; C1s := C1; C2s := C2; end else
      if c1 = c1s then
      if l2 < l2s then begin L1s := L1; L2s := L2; C1s := C1; C2s := C2; end else
      if l2 = l2s then
       if ( l1 + l2 + c1 + c2 ) < ( l1s+l2s+c1s+c2s ) then
                       begin
                         L1s := l1; L2s:= l2; C1s := c1; C2s := c2; end;
      end;
   end;


   procedure solve;
    var vv1, vv : qword;
        ok : boolean;
        k : longint;
     begin

 for L1 := 1 to N - 2 do // fixam prima linie
  begin
   fillchar( sel, sizeof( sel ), 0 );
   for p := 1  to 9 do  // fixam suma pt prima zona
     begin
     // caut coloana
     binary_linie( 0, 1, N, p );
     if poz <> - 1 then
      begin c1 := poz; // am fixat c1
       // fixam suma pt zona 2
       if c1 <= N - 2 then
        for pp := 1 to 9 do
         if p <> pp then
          begin
           binary_linie( c1, c1 + 1, N, pp );
            if (poz <> - 1) and ( poz < N ) then
             begin
              c2 := poz;
              sel[p] := 1; sel[pp] := 1;
              vv1 := return( 1, C2 + 1, L1, N );
              ok := true;
              if not cauta( vv1 ) then ok := false;
              // caut suma zonei 3
              // avem fixate L1, C1, C2
             // fixam suma pt zona 4
             if ok then
               for k := 1 to 9 do
                begin
                fillchar( sel, sizeof( sel ), 0 );
                 ok := cauta( vv1 ); sel[p] := 1; sel[pp] := 1;
                 if sel[k] = 0 then
                    begin
                      // cautam binar L2
                      sel[k] := 1;
                      binary_col( L1 + 1, 1, c1, L1 + 1, N, k );
                      if ( poz <> N ) and ( poz <> - 1 ) then
                           begin
                             L2 := poz; // acum le am fixate pe toate
                             // verific cum stam cu restul sumelor
                             ok := true;
                             vv := return( L1 + 1, C1 + 1, L2, C2 );
                             if not cauta( vv ) then ok := false;
                             vv := return( L1 + 1, C2 + 1, L2, N );
                             if not cauta( vv ) then ok := false;
                             vv := return( L2 + 1, 1, N, C1 );
                             if not cauta( vv ) then ok := false;
                             vv := return( L2 + 1, C1 + 1, N, c2 );
                             if not cauta( vv ) then ok := false;
                             vv := return( L2 + 1, C2 +1, N, N );
                             if not cauta( vv ) then ok := false;
                             if ok then solutie( L1, L2, C1, C2 );
                          end;
                      fillchar( sel, sizeof( sel ), 0 );
                 end;
      end;
      end;
      end;
      end;
      end;
      end;
      end;

 procedure save;
  begin
   assign( g, FOUT ); rewrite( g ); writeln( g, l1s,' ',l2s,' ',c1s,' ',c2s );
   close( g );
  end;

   begin
   first := true;
   read_data;
   solve;
   save;
   end.