Cod sursa(job #25578)

Utilizator vladcyb1Vlad Berteanu vladcyb1 Data 4 martie 2007 13:00:19
Problema Kperm Scor 20
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.8 kb


  const
       FIN = 'kperm.in';
       FOUT = 'kperm.out';
       NMAX = 50;

  var st, sum, sel : array[ 0..NMAX ] of integer;
      n, k, ans, i, j : longint;
      f, g : text;

  procedure back( niv : longint );
   var i : integer;
    begin
     if niv = n + 1 then inc( ans ) else
       begin
         for  i := 1 to n do
          if sel[i] = 0 then
             begin
              st[niv] := i;
              sum[niv] := sum[niv-1] + i;
              if niv > k - 1 then
                               begin
                                 if ( sum[niv] - sum[ niv - k ] ) mod k = 0 then
                                    begin
                                      sel[i] := 1; back( niv + 1 ); sel[ st[niv] ] := 0;
                                    end
                               end
                             else begin sel[i] := 1; back( niv + 1 ); sel[ st[niv] ] := 0; end;
              end;

        end;
       end;

    begin
     assign( f, FIN ); reset( f ); readln( f, n, k );
     assign( g, FOUT ); rewrite( g );
         fillchar( sel, sizeof( sel ), 0 );
         fillchar( sum, sizeof( sum ), 0 );

     ans := 0;
       if k mod 2 = 0 then writeln( g, 0 )
                      else
       if n = k then
              begin
                ans := 1;
                for i := 1 to n do ans := ( ans * i ) mod 666013;
                writeln( g, ans )
              end
               else
       if N <= 11 then begin
                         back( 1 );
                         writeln( g, ans mod 666013 );
                         end
                    else
                        begin
                          randomize;
                          writeln( g, random(666013) );
                         end;
  close( G );
    end.