Const MaxM              = 5000;

Var   Q                 : Array[1..MaxM,1..2] of Longint;
      C                 : Array[1..MaxM] of Byte;

      O                 : Array[1..2,0..MaxM] of Integer;
      T                 : Integer;

      N                 : Longint;
      M                 : Integer;

Procedure DelL(X        : Integer);
Var i                   : Integer;
Begin
  For i := 1 to T do
    If Q[O[1,i],1]>Q[X,1] then Break else
      If Q[O[1,i],1]=Q[X,1] then
        If Q[O[1,i],2]<=Q[X,2] then
          Begin
            Q[X,1] := Q[O[1,i],2]+1;
            C[X] := C[X] xor C[O[1,i]];
            If Q[X,1]>Q[X,2] then Break;
          End;
End;

Procedure DelR(X        : Integer);
Var i                   : Integer;
Begin
  For i := T downto 1 do
    If Q[O[2,i],2]<Q[X,2] then Break else
      If Q[O[2,i],2]=Q[X,2] then
        If Q[O[2,i],1]>=Q[X,1] then
          Begin
            Q[X,2] := Q[O[2,i],1]-1;
            C[X] := C[X] xor C[O[2,i]];
            If Q[X,1]>Q[X,2] then Break;
          End;
End;

Function DeleteL(X : Integer) : Integer;
Var Temp           : Integer;
    i              : Integer;
Begin
  For i := 1 to T do
    If Q[X,1]=Q[O[1,i],1] then
      If Q[X,2]<Q[O[1,i],2] then
        Begin
          Q[O[1,i],1] := Q[X,2]+1;
          C[O[1,i]] := C[X] xor C[O[1,i]];
          Temp := X; X := O[1,i]; O[1,i] := Temp;
        End else
        Begin
          Q[X,1] := Q[O[1,i],2]+1;
          C[X] := C[X] xor C[O[1,i]];
       End;
  DeleteL := X;
End;

Function  DeleteR(X : Integer) : Integer;
Var Temp            : Integer;
    i               : Integer;
Begin
  For i := T downto 1 do
    If Q[X,2]=Q[O[2,i],2] then
      If Q[X,1]>Q[O[2,i],1] then
        Begin
          Q[O[2,i],2] := Q[X,1]-1;
          C[O[2,i]] := C[X] xor C[O[2,i]];
          Temp := X; X := O[2,i]; O[2,i] := Temp;
        End else
        Begin
          Q[X,2] := Q[O[2,i],1]-1;
          C[X] := C[X] xor C[O[2,i]];
       End;
  DeleteR := X;
End;

Function Pass(X         : Integer) : Boolean;
Var TempL,TempR         : Integer;
    i,j,k               : Integer;
Begin
  DelL(X);
  If Q[X,1]<=Q[X,2] then
    DelR(X);
  Pass := (Q[X,1]<=Q[X,2]) or (C[X]=0);
  If Q[X,1]<=Q[X,2] then
    Begin
      TempL := DeleteL(X);
      TempR := DeleteR(X);
    End else Exit;
  i := 1; j := T;
  If T=0 then j := 1 else
    If (Q[O[1,1],1]<Q[TempL,1]) and (Q[TempL,1]<Q[O[1,T],1]) then
      Begin
        Repeat
          k := (i+j) div 2;
          If Q[O[1,k],1]<Q[TempL,1] then j := k
                                    else i := k+1;
        Until j-i<2;
      End else
      Begin
        If Q[O[1,T],1]>Q[TempL,1] then j := 1
                                  else j := T+1;
      End;
  For i := j+1 to T+1 do
    O[1,i] := O[1,i-1];
  O[1,j] := TempL;

  i := 1; j := T;
  If T=0 then j := 1 else
    If (Q[O[2,1],2]<Q[TempR,2]) and (Q[TempL,2]<Q[O[2,T],2]) then
      Begin
        Repeat
          k := (i+j) div 2;
          If Q[O[2,k],2]<Q[TempL,2] then j := k
                                    else i := k+1;
        Until j-i<2;
      End else
      Begin
        If Q[O[2,T],2]>Q[TempL,2] then j := 1
                                else j := T;
      End;
  For i := j+1 to T+1 do
    O[2,i] := O[2,i-1];
  O[2,j] := TempR;
  Inc(T);
End;

Procedure Main;
Var   i,j       : Integer;
      Str       : String;
      PrEnd     : Boolean;
Begin
  Repeat
    Readln(N);
    If N<>-1 then
      Begin
        Readln(M);
        PrEnd := True; T := 0;
        Fillchar(Q,Sizeof(Q),0);
        Fillchar(O,Sizeof(O),0);
        Fillchar(C,Sizeof(C),0);
        For i := 1 to M do
          Begin
            Readln(Q[i,1],Q[i,2],Str);
            C

> 6
> 000111
> 111000
> 100100
> 001001
> 100110
> 011001

> 6
> 000111
> 111000
> 100100
> 001001
> 100110
> 011001

I use Borland 3.1. Therefore, I can't get large storage as in
FreePascal. Example:

a: array[1...100000] of longint in Free Pascal.
But

long a[1000000];
It's  impossible.

Someone advised me to use model "Large". But I don't know how to use
it and what it is.

test

The problem statement says that the sample input
-0.051e0
1
gives 0.0 as output, and not -0.0
Is that right or the sample is wrong?

If it was
-0.051e0
2
what should I output? -0.05 or 0.05?

Thanks a lot

Vinicius Fortuna
IC-Unicamp

I can't understand what's going on... :( Tested this thouslands of
times using windows calendar, got WA :( This seems to output all
correctly (dots are spaces, everything is aligned, even 1-digit
numbers, date is highlighned by square brackets). Ppl plz help!


=================================[Cut]=============================
program WhichDayIsIt;

const DaysOfWeek: array[1..7] of String[3] = (
        'mon', 'tue', 'wed', 'thu', 'fri', 'sat', 'sun'
      );

function YearLength(Year: Integer): Integer;
begin
  if ((Year mod 4 = 0) and (Year mod 100 <> 0)) or (Year mod 1000 =
0) then
    YearLength := 366
  else
    YearLength:= 365;
end;

function MonthLength(Month, Year: Integer): Integer;
begin
  case Month of
    1, 3, 5, 7, 8, 10, 12: MonthLength := 31;
    2: if YearLength(Year) = 365 then MonthLength := 28 else
MonthLength := 29;
  else
    MonthLength := 30;
  end;
end;

function Delta(Day, Month, Year: Integer): Integer;
var i, Temp: Integer;
begin
  Temp := 0;
  for i := 1600 to (Year - 1) do
    Temp := Temp + YearLength(i);
  for i := 1 to (Month - 1) do
    Temp := Temp + MonthLength(i, Year);
  Temp := Temp + Day - 1;
  Delta := Temp;
end;

function DOW(Day, Month, Year: Integer): Byte;
begin
  DOW := (Delta(Day, Month, Year) + 3) mod 7 + 1;
end;

function IntToStr2(i: Integer): String;
var St: String;
begin
  Str(i, St);
  if Length(St) < 2 then St := ' ' + St;
  IntToStr2 := St;
end;

var Day, Month, Year: Integer;
    i, DW: Integer;
    Out: array[1..7] of string;
begin
  Read(Day, Month, Year);
  DW := DOW(1, Month, Year);
  for i := 1 to 7 do
  begin
    Out[i] := DaysOfWeek[i] + ' ';
    if i < DW then
      Out[i] := Out[i] + '    ';
  end;
  for i := 1 to MonthLength(Month, Year) do
  begin
    if i = Day then
      Out[(i + DW - 2) mod 7 + 1] := Out[(i + DW - 2) mod 7 + 1]
+ '[' + IntToStr2(i) + ']'
    else
      Out[(i + DW - 2) mod 7 + 1] := Out[(i + DW - 2) mod 7 + 1]
+ ' ' + IntToStr2(i) + ' ';
  end;
  for i := 1 to 7 do
    WriteLn(Out[i]);
end.
====================================[Cut]===========================

should i output '11' or '1'?
'7' or '17'?
how many digits could have an integer number?

6
000111
111000
100100
001001
100110
011001

I don't understand why answer for
5 5
0 0 2 0 2
0 0 0 0 0
0 0 0 0 0
0 0 0 5 0
1 0 0 4 0

must be
2 2 -1 2 -1
3 2 2 7 2
1 7 7 5 7
1 5 5 -1 5
-1 1 4 -1 4

i think that b[4, 2] must be 6 and b[3, 2] must be 8

Vokin Andrei e-mail: vok@sbor.ru

type
  sentence=array [1..10000] of char;
const
  hidigit:set of char =['A'..'Z'];
  lodigit:set of char=['a'..'z'];
  stop:set of char=['.','!','?'];
var
  mist,n:integer;
{  fin:text; }
  sent:sentence;
  c:char;
procedure ProcessData(sent:sentence;len:integer);
var
  i:integer;
begin
  for i:=1 to len do
  begin
    if sent[i] in hidigit then break;
    if sent[i] in lodigit then
    begin
      inc(mist);
      break;
    end;
  end;
  for i:=i+1 to len do
  begin
    if (sent[i] in hidigit) and ((sent[i-1] in hidigit) or (sent[i-1]
in lodigit)) then
      inc(mist);
  end;
end;
procedure ReadData;
var i:integer;
begin
 { assign(fin,'input.txt');
  reset(fin);}
  mist:=0;
  while not seekeof do
  begin
    FillChar(sent,sizeof(sent),0);
    i:=1;
    repeat
      read(c);
      sent[i]:=c;
      inc(i);
    until c in stop;
    ProcessData(sent,i-1);
  end;
end;
procedure OutData;
begin
  writeln(mist);
 { close(fin);}
end;
begin
  ReadData;
  OutData;
end.

I did it like this:
Why I get wrong?

type
  td=array[1..26,0..26]of integer;
  tt=record
    a,b:integer;
    x:array[1..2]of integer;
    xi:integer;
    ty:integer;
    d:td;
  end;
var
  s1,s2:string;
  i,n:integer;
  d1,d2:td;
  t:array[1..50]of ^tt;
procedure turn(s:string;var d:td);
  var
    i,o,p:integer;
    k:integer;
  begin
    k:=1;
    new(t[k]);
    fillchar(t[k]^,sizeof(t[k]^),0);
    t[k]^.x[1]:=1;
    t[k]^.x[2]:=1;
    s:=s+'.';
    for i:=1 to length(s) do
      begin
        with t[k]^ do
          begin
            if s[i] in ['(',')','.','A'..'Z','+'] then
              begin
                if ty=1
                  then d[a,b]:=d[a,b]+x[1]*x[2];
                if ty=2
                  then begin
                    for o:=1 to 26 do
                      for p:=0 to 26 do
                        d[o,p]:=d[o,p]+t[k+1]^.d[o,p]*x[2]*x[1];
                    dispose(t[k+1]);
                  end;
                x[1]:=1;
                xi:=0;
              end;
            case s[i] of
              'A'..'Z':begin
                ty:=1;
                a:=byte(s[i])-byte('A')+1;
                b:=0;
              end;
              'a'..'z':begin
                b:=byte(s[i])-byte('a')+1;
              end;
              '0'..'9':begin
                if xi=0 then
                  begin
                    if a=0
                      then xi:=2
                      else xi:=1;
                    x[xi]:=byte(s[i])-byte('0');
                  end
                  else x[xi]:=x[xi]*10+byte(s[i])-byte('0');
              end;
              '(':begin
                ty:=2;
                inc(k);
                new(t[k]);
                fillchar(t[k]^,sizeof(t[k]^),0);
                t[k]^.x[1]:=1;
                t[k]^.x[2]:=1;
              end;
              ')':begin
                dec(k);
              end;
              '+':begin
                a:=0;
                b:=0;
                x[1]:=1;
                x[2]:=1;
                xi:=0;
                ty:=0;
              end;
            end;
          end;
      end;
    delete(s,length(s),1);
    d:=t[k]^.d;
  end;
function bj(var d1,d2:td):boolean;
  var
    i,j:integer;
  begin
    for i:=1 to 26 do
      for j:=0 to 26 do
        if d1[i,j]<>d2[i,j] then
          begin
            bj:=false;
            exit;
          end;
    bj:=true;
  end;
begin
  readln(s1);
  turn(s1,d1);
  readln(n);
  for i:=1 to n do
    begin
      readln(s2);
      turn(s2,d2);
      if bj(d1,d2)
        then writeln(s1,'==',s2)
        else writeln(s1,'!=',s2)
    end;
end.

Why i can`t send any program. In Status you can see only waiting!!!!!
Server is down?

Help!!!

Is there any packed problems archive for downloading as it's done at Spanish site?

Here is my program.

var a:array[0..1000] of char;
    n,i,top,j,one,oo,k:integer;
    s:longint;
    c:char;

begin
 readln(n);
 while not eof do
 begin
  top:=0;
  one:=0;
  while not eoln do
  begin
   read(c);
   if (c<>' ') then
   begin
    inc(top);
    a[top]:=c;
    if c='1' then inc(one);
   end;
  end;
  s:=0;
  for j:=1 to top do
  if a[j]='1' then s:=s+j;
  if top=n then
  begin
   if s mod (n+1)=0 then
   begin
    for j:=1 to n do write(a[j]);
    writeln;
   end else
   begin
    for j:=1 to n do
    if a[j]='1' then
    begin
     if (s-j) mod (n+1)=0 then
     begin
      a[j]:='0';
      for j:=1 to n do write(a[j]);
      writeln;
      break;
     end;
    end;
   end;
  end else
  if top=n-1 then
  begin
   a[0]:=' ';
   oo:=0;
   for j:=0 to n-1 do
   begin
    if a[j]='1' then inc(oo);
    if (s+one-oo) mod (n+1)=0 then
    begin
     for k:=1 to j do write(a[k]);
     write('0');
     for k:=j+1 to top do write(a[k]);
     writeln;
     break;
    end else
    if (s+one-oo+j+1) mod (n+1)=0 then
    begin
     for k:=1 to j do write(a[k]);
     write('1');
     for k:=j+1 to top do write(a[k]);
     writeln;
     break;
    end;
   end;
  end else
  begin
   oo:=0;
   for j:=1 to n+1 do
   begin
    if a[j]='0' then
    begin
     if (s-one+oo) mod (n+1)=0 then
     begin
      for k:=1 to j-1 do write(a[k]);
      for k:=j+1 to n+1 do write(a[k]);
      writeln;
      break;
     end;
    end else
    if a[j]='1' then
    begin
     if (s-one+oo-j) mod (n+1)=0 then
     begin
      for k:=1 to j-1 do write(a[k]);
      for k:=j+1 to n+1 do write(a[k]);
      writeln;
      break;
     end;
    end;
   if a[j]='1' then inc(oo);
   end;
  end;
  readln;
 end;
end.

Part of my <AC 0.02s> C++ code:

// 1201
#include <iostream.h>
#include <math.h> //for some calculations ;)

int d,m,y;

// Here are your subroutines

int main() {
  int flg=0;
  int i,j,lim,k=0;
  int a[10][10];
  char *w[]={"mon","tue","wed","thu","fri","sat","sun"};

  cin>>d>>m>>y;

  for (i=0;i<10;i++)
    for (j=0;j<10;j++) a[i][j]=0;

  // Here you put your data in a double array

  for (i=0;i<7;i++) {
    cout<<w[i];
    for (j=0;j<6;j++)
      if (a[i][j])
    if (a[i][j]==d) {
      if (d>9) cout<<" ["<<d<<"] ";
      else cout<<" [ "<<d<<"] ";
      flg=j<4;
    }
    else
      if (flg) {
        if (a[i][j]>9) cout<<" "<<a[i][j]<<" ";
        else cout<<"  "<<a[i][j]<<" ";
        flg=0;
      }
      else
        if (a[i][j]>9) cout<<"  "<<a[i][j]<<" ";
        else cout<<"   "<<a[i][j]<<" ";
    else cout<<"     ";
    cout<<endl;
  }
  return 0;
}