ENG  RUSTimus Online Judge
Online Judge
Задачи
Авторы
Соревнования
О системе
Часто задаваемые вопросы
Новости сайта
Форум
Ссылки
Архив задач
Отправить на проверку
Состояние проверки
Руководство
Регистрация
Исправить данные
Рейтинг авторов
Текущее соревнование
Расписание
Прошедшие соревнования
Правила
вернуться в форум

Обсуждение задачи 1042. Центральное отопление

Make equations!!
Послано Sun-ho, Cho 27 дек 2001 15:21
make differential equations
and use Gauss-Jordan reduction. and then you can solve O(n^3)
Re: Make equations!!
Послано Dejan Kolundzija 8 янв 2002 23:14
> make differential equations
> and use Gauss-Jordan reduction. and then you can solve O(n^3)

Hi there!

I made nxn equation system and I solved it with Gauss reduction in O
(n^2) but I still got WA! I've used brute force to find the shortest
solution. Maybe there's better way to do this ? Here's my program :)

faithrespectdejan

program P1042 ;

    const
      maxN    =    250 ;

    type
      TEquations    =    array [1 .. maxN + 1, 1 .. maxN + 1]
of Byte ;
    TResult    =    set of 1 .. maxN ;

    var
      N    :    Integer ;
    E    :    TEquations ;

    Solved    :    Boolean ;

    Res    :    TResult ;
    minRes    :    Byte ;


      procedure readInput ;
      var
          i,    a    :    Integer ;
        begin
{          Assign(Input, 'input.txt') ; Reset(Input) ;}

          Read(N) ;
        FillChar(E, SizeOf(E), 0) ;
        for i := 1 to N do
            begin
              Read(a) ;
            while a <> -1 do
                begin
                  E [a, i] := 1 ;
                Read(a) ;
              end ;

            E [i, N + 1] := 1 ; { result }
          end ;
      end ;


    procedure SwapByte(var a, b :  Byte) ;
        var    c    :    Byte ; begin c := a ; a := b ; b :=
c ; end ;


    procedure SwapEquations(i, j : Byte) ;
        var    c    :    Byte ;
      begin
          for c := 1 to N + 1 do SwapByte(E [i, c], E [j, c]) ;
      end ;


    procedure FindCorrect(place : Byte) ;
      var    i    :    Byte ;
        begin
          if E [place, place] = 1 then EXIT ;

          for i := place + 1 to N do
            if E [i, place] = 1 then
                        begin
                            SwapEquations
(i, place) ;
              EXIT ;
            end ;
      end ;


    procedure AddEquation(a, b : Byte) ;
      var    i    :    Byte ;
        begin
          for i := a to N + 1 do
            E [b, i] := E [b, i] xor E [a, i] ;
      end ;


    procedure FindRes(eq, count : Byte ; tmpRes : TResult) ;
      var
          i,    sum    :    Byte ;
        begin
          if eq = 0 then
            begin
              Solved := TRUE ;
            if count < minRes then begin minRes := count ; Res :=
tmpRes ; end ;
          end
        else
            if count <= minRes then
                begin
                  sum := 0 ;
                for i := eq + 1 to N do
                    if i in tmpRes then sum := sum + E [eq, i] ;
                sum := E [eq, N + 1] xor sum ;

              if sum = 1 then
                  if E [eq, eq] = 1 then FindRes(eq - 1, count + 1,
tmpRes + [eq])
                else EXIT
              else
                  if E [eq, eq] = 1 then FindRes(eq - 1, count, tmpRes)
                else
                         begin
                        FindRes(eq - 1, count + 1, tmpRes + [eq]) ;
                        FindRes(eq - 1, count, tmpRes) ;
                    end ;
          end ;
      end ;


    procedure Solve    ;
      var
          i,    j    :    Byte ;
        begin
          for i := 1 to N do
            begin
              FindCorrect(i) ;
            if E [i, i] = 0 then CONTINUE ;
            for j := i + 1 to N do
                if E [j, i] = 1 then
                  AddEquation(i, j) ;
          end ;

        Solved := FALSE ;

        minRes := N + 1 ;
        FindRes(N, 0, []) ;
      end ;


    procedure writeOutput ;
      var
                i    :    Integer ;
          Start    :    Boolean ;
        begin
          if Solved then
                    begin
              Start := FALSE ;
            for i := 1 to N do
                if i in Res then
                  if Start then Write(' ', i) else begin Start :=
TRUE ; Write(i) ; end ;
                    end
        else Write('No solution') ;
      end ;


  begin
      readInput ;
    Solve ;
    writeOutput ;
  end.
Re: Make equations!! -> CORRECTION :)
Послано Dejan Kolundzija 8 янв 2002 23:16
> > make differential equations
> > and use Gauss-Jordan reduction. and then you can solve O(n^3)
Correction :
I solved it in O(n^3). Sorry :)