Olimpiada Națională de Informatică - Mediaș, 1999

SOLUȚIILE problemelor propuse

În numărul 5/1999 al GInfo am publicat cele 24 de probleme de la ONI ‘99, organizată la Mediaș. Redacția GInfo, preocupată de a vă oferi posibilitatea de a "crește" mereu, vă prezintă rezolvările unora dintre ele.

P059901: Expresie

Sabău Florin, clasa a XI-a, Reșița

Procedura Eval realizează evaluarea expresiei. Aceasta defalcă expresia stocată în variabila exp în părțile componente:

- mai întâi operatorii - în vectorul o

- apoi constantele numerice și variabilele - în vectorul op

Urmează evaluarea propriu-zisă în doi pași:

- înmulțirea;

- adunarea și scăderea.

Listing expresie.pas

var exp:string;

v:array['a'..'e'] of Longint;

e:array['a'..'e'] of Boolean;

op:array[1..255] of Comp;

o:array[1..255] of Char;

i:Integer;

s:Comp;

function s2i(s:string):Longint;

var i:Longint;

code:Integer;

begin

val(s,i,code);

s2i:=i

end;

procedure citeste;

var s:string;

c:Char;

begin

Assign(input,'EX.IN'); Reset(input);

Readln(exp);

Fillchar(e,Sizeof(e),0);

i:=0;

while not Eof do

begin

Inc(i);

Readln(s);

c:=s[1];

v[c]:=s2i(Copy(s,3,Length(s)-2));

e[c]:=true

end;

Close(input);

Assign(output,'EX.OUT');

Rewrite(output)

end;

function nedefinita:Boolean;

begin

nedefinita:=false;

for i:=1 to Length(exp)

do

if (exp[i] in ['a'..'e'])

and

(e[exp[i]]=false)

then

begin nedefinita:=true; Break end

end;

function eval:string;

var vec,i,n,m,k:Integer;

sw:Comp;

begin

i:=1;

n:=0; m:=0;

o[1]:='+';

while i<=Length(exp) do

begin

vec:=i;

while not (exp[i] in ['a'..'e','+','-'])

and (i<=Length(exp)) do i:=i+1;

if (vec<>i)

then

begin

Inc(n);

op[n]:=s2i(Copy(exp,vec,i-vec));

if i<=Length(exp)

then

if exp[i] in ['a'..'e']

then o[n+1]:='*'

else

begin o[n+1]:=exp[i]; Inc(i) end

end;

vec:=i;

while (exp[i] in ['a'..'e'])

and

i<=Length(exp))

do

begin

Inc(n);

op[n]:=v[exp[i]];

o[n+1]:='*';

Inc(i)

end;

if (vec<>i)

then

begin

if exp[i] in ['0'..'9']

then o[n+1]:='*'

else

begin o[n+1]:=exp[i]; Inc(i) end

end

end;

o[n+1]:=#0;

i:=1;

while i<=n do { Pasul 1 - Inmultirea }

begin

vec:=i;

while (o[i+1]='*') and (i<=n) do i:=i+1;

if (i<=n)

then

begin

sw:=1;

for k:=vec to i

do

begin

sw:=sw*op[k];

if k<>vec then o[k]:=#0

end;

op[vec]:=sw

end;

while (o[i+1]<>'*') and (i<=n) do i:=i+1

end;

s:=0;

for i:=1 to n do

if o[i]='+'

then s:=s+op[i]

else

if o[i]='-'

then s:=s-op[i];

Writeln(s:0:0)

end;

Begin

citeste;

if nedefinita

then Writeln('NEDEFINITA')

else eval;

Close(output)

End.

P059902: Nasturi

Sabău Florin, clasa a XI-a, Reșița

Problema nu are soluție pentru următoarele seturi de date:

- numărul de nasturi (x) este impar;

- numărul de nasturi de extras este cu 2 mai mic decât numărul total de nasturi (n*n);

- numărul de nasturi de extras este mai mic decât 4 (=2).

Dacă nici una dintre condiții nu este îndeplinită atunci avem soluție. Dacă numărul x este divizibil cu 4 atunci simpla extragere a unor grupuri de nasturi de câte 4 este suficientă.

..

..

Dacă nu, se extrag câte 4 nasturi până când mai rămân 6. Aceștia șase sunt extrași din colțul din dreapta-jos al matricei în felul următor:

o..

.o.

..o

ori, dacă antepenultima linie a matricei este ocupată în întregime, avem:

-....

-..oo

-.oo.

-.o.o

( '.' reprezintă locul de unde se extrag nasturi, iar 'o' nasturi neextrași).

Listing: NASTURI.PAS

var n,x,i,j:Integer;

a:array[1..31,1..31] of Char;

gata:Boolean;

procedure citeste;

begin

Assign(input,'NASTURI.IN'); Reset(input);

Readln(n,x); Close(input);

Assign(output,'NASTURI.OUT'); Rewrite(output)

end;

Begin

citeste;

if (x mod 2<>0) or (x>=n*n-2) or (x<4)

then Writeln('fara solutie')

else

begin

Fillchar(a,Sizeof(a),'o');

gata:=false;

for i:=1 to n div 2 do

if not gata

then

for j:=1 to n div 2 do

begin

if (x=6) or (x=0)

then

begin gata:=true; Break end;

a[2*i-1,2*j-1]:='.';

a[2*i,2*j-1]:='.';

a[2*i-1,2*j]:='.';

a[2*i,2*j]:='.';

Dec(x,4);

if (x=6) or (x=0)

then

begin gata:=true; Break end

end;

if x=6

then

begin

if a[n-3,n]<>'.'

then

begin

a[n-2,n-1]:='.';

a[n-2,n]:='.';

a[n-1,n]:='.';

a[n-1,n-2]:='.';

a[n,n-2]:='.';

a[n,n-1]:='.'

end

else

begin

a[n-2,n-1]:='o';

a[n-2,n]:='o';

for i:=n-5 to n-3

do

begin

a[n-1,i]:='.';

a[n,i]:='.';

a[n-1,n]:='.';

a[n,n-1]:='.'

end

end

end;

for i:=1 to n do

begin

for j:=1 to n do Write(a[i,j]);

Writeln

end

end;

Close(output)

End.

P059904: Furtună în Balcani

Sabău Florin, clasa a XI-a, Reșița

Pentru această problemă am folosit algoritmul "fill". Pentru început se umple exteriorul "taberelor" cu un alt caracter ('o') pentru a diferenția exteriorul de interiorul taberelor. Se pornește din punctul (1,1) deoarece se știe din problemă că taberele nu ating marginea. Urmează apoi o parcurgere a matricei: când se întâlnește sârma ghimpată ('X') se umple exteriorul taberei (caracterul 'o') pe direcțiile N, S, V, E cu mine ('M').

În final se tipărește în fișierul de ieșire matricea.

Listing: BALCANI.PAS

{$m 65000,0,0}

var m,n,i,j:Integer;

a:array[1..100,1..100] of Char;

x,y:Integer;

cul1,cul2:Char;

procedure citeste;

begin

Assign(input,'NATO.IN');

Reset(input);

Readln(m,n);

for i:=1 to m do

begin

for j:=1 to n do Read(a[i,j]);

Readln

end;

Close(input);

Assign(output,'NATO.OUT');

Rewrite(output)

end;

procedure fill;

begin

if a[x,y]<>cul1 then Exit;

a[x,y]:=cul2;

Inc(x); fill; Dec(x);

Inc(y); fill; Dec(y);

Dec(x); fill; Inc(x);

Dec(y); fill; Inc(y)

end;

Begin

citeste;

x:=1; y:=1; cul1:='.'; cul2:='o';

fill;

for x:=1 to m do

for y:=1 to n do

begin

if a[x,y]='X'

then

begin

if a[x-1,y]='o' then a[x-1,y]:='M';

if a[x,y-1]='o' then a[x,y-1]:='M';

if a[x+1,y]='o' then a[x+1,y]:='M';

if a[x,y+1]='o' then a[x,y+1]:='M'

end

end;

for x:=1 to m do

begin

for y:=1 to n do

if a[x,y]='o' then Write('.')

else Write(a[x,y]);

Writeln

end;

Close(output)

End.

P059905: Semne

Sabău Florin, clasa a XI-a, Reșița

Nu se poate obține o expresie în cazul în care n este mai mic decât 3. Pentru nł3 se observă că folosind succesiunea ++--++--... pentru un număr de forma 4k+3 se obține 0. Pentru un număr de forma 4k+1, folosind aceeași succesiune de operatori, am obține 1, deci trebuie să micșorăm expresia cu o unitate. De aceea vom substitui începutul expresiei +1+2 (=3) cu +1*2 (=2), în rest aceasta rămâne neschimbată. Pentru 4k vom folosi înșiruirea:

+-+-...+--+...-+-+

în care primul și ultimul termen sunt anulați de al doilea și penultimul etc. Pentru 4k+2 vom porni de la aceeași înșiruire de operatori ca și la 4k. Aici avem 2 termeni în plus, a căror diferență este de 1 (sau -1). Dacă pentru acești ultimi termeni se folosește -+, atunci trebuie să anulăm acest 1 la începutul expresiei. Înlocuim deci +1-2 (=-1) cu -1*2 (=-2).

Listing: SEMNE.PAS

const semn:array[0..1] of Char=('+','-');

var n:Longint;

procedure citeste;

begin

Assign(input,'ZERO.IN'); Reset(input);

Readln(n); Close(input)

end;

function neg(x:Byte):Byte;

begin x:=(x+1) mod 2; neg:=x end;

procedure rezolva;

var i:Longint;

sem:0..1;

begin

case (n mod 4) of

1: begin

Write('+*'); i:=3; sem:=1;

while i<n

do

begin

Write(semn[sem],semn[sem]);

i:=i+2; sem:=neg(sem)

end;

Writeln(semn[sem])

end;

2: begin

Write('-*');

sem:=0;

for i:=3 to (n-2) div 2

do

begin Write(semn[sem]);

sem:=neg(sem)

end;

sem:=neg(sem);

for i:=1 to (n-2) div 2

do

begin Write(semn[sem]);

sem:=neg(sem)

end;

Writeln('-+')

end;

3: begin

for i:=1 to n div 4 do Write('++--');

Writeln('++-')

end;

0: begin

for i:=1 to n div 4 do Write('+-');

for i:=1 to n div 4 do Write('-+')

end

end

end;

Begin

citeste;

n:=12;

if n<3 then Writeln('NU') else rezolva;

Close(output)

End.

P059907: Vile

Andrei Vancea, student Universitatea Tehnică, Cluj

Problema este rezolvată folosind metoda Branch&Bound. Pentru fiecare configurație se reține camera curentă și starea becurilor din cele n camere. Având în vedere faptul că numărul de camere este mai mic decât 16 starea becurilor se poate reține într-un word (un bit pentru fiecare bec). Dintr-o configurație se poate trece în alta prin trecerea în altă cameră sau schimbarea stării unui bec conform condițiilor din enunț. În tabloul ajuns sunt marcate configurațiile care s-au expandat pentru a nu se mai expanda încă o dată.

Existența unui număr mic de configurații (11*2^11) garantează găsirea soluției într-un timp rezonabil.

Listing: VILE.PAS

{$M 65384,0,655360}

program vile;

type plista=^lista;

lista=record

camera:Byte;

becuri,nrmut:Word;

urm,pred:plista;

end;

var n,i,c:Byte;

nr,nr1,nr2:array[1..11] of Byte;

vec,ap,st:array[1..11,1..11] of Byte;

ajuns:array[1..11,1..1 shl 11] of Boolean;

l,k:Word;

prim,ultim,cr,p:plista;

gasitsolutie:Boolean;

procedure Citire;

var f:Text;

i,j:Byte;

begin

Assign(f,'VILA.IN'); Reset(f);

Readln(f,n);

for i:=1 to n do

begin

Read(f,nr[i]);

for j:=1 to nr[i] do Read(f,vec[i,j])

end;

for i:=1 to n do

begin

Read(f,nr1[i]);

for j:=1 to nr1[i] do Read(f,ap[i,j])

end;

for i:=1 to n do

begin

Read(f,nr2[i]);

for j:=1 to nr2[i] do Read(f,st[i,j])

end;

Close(f)

end;

procedure scriere;

var f:Text;

i:Byte;

procedure Mutari(p:plista);

var i:Byte;

begin

if p=prim then Exit;

Mutari(p^.pred);

if p^.camera<>p^.pred^.camera

then Writeln(f,'m',p^.camera)

else

for i:=0 to n-1 do

if (p^.becuri and (1 shl i)=0) and

(p^.pred^.becuri and (1 shl i)<>0)

then

begin Writeln(f,'s',i+1); Break end

else

if (p^.becuri and (1 shl i)<>0) and

(p^.pred^.becuri and (1 shl i)=0)

then

 

begin

Writeln(f,'a',i+1); Break

end

end;

begin

Assign(f,'VILA.OUT'); Rewrite(f);

if cr=

nil

then Writeln(f,'Nu exista solutie')

else

begin

Writeln(f,cr^.nrmut);

Mutari(cr)

end;

Close(f)

end;

Begin

Citire;

Fillchar(ajuns,Sizeof(ajuns),0);

ajuns[1,1]:=true;

l:=1;

new(prim);

prim^.camera:=1; prim^.becuri:=1;

prim^.nrmut:=0; prim^.urm:=nil;

prim^.pred:=nil; ultim:=prim;

cr:=prim; gasitsolutie:=false;

while cr<>nil do

begin

c:=cr^.camera;

for i:=1 to nr[c] do

if (cr^.becuri

and

(1 shl (vec[c,i]-1))<>0) and

(not ajuns[vec[c,i],cr^.becuri])

then

begin

ajuns[vec[c,i],cr^.becuri]:=true;

New(p);

p^.urm:=nil;

p^.pred:=cr;

p^.camera:=vec[c, i];

p^.becuri:=cr^.becuri;

ultim^.urm:=p;

ultim:=p;

p^.nrmut:=cr^.nrmut+1;

if (vec[c,i]=n)

and

(p^.becuri=1 shl (n-1))

then

begin

cr:=p;

gasitsolutie:=true;

Break

end

end;

if gasitsolutie then Break;

for i:=1 to nr1[c] do

if (cr^.becuri

and

(1 shl (ap[c,i]-1))=0) and

(not ajuns[c, cr^.becuri+

(1 shl (ap[c,i]-1))])

then

begin

ajuns[c, cr^.becuri+

(1 shl (ap[c,i]-1))]:=true;

New(p); p^.urm:=nil;

p^.pred:=cr;

p^.camera:=cr^.camera;

p^.becuri:=cr^.becuri+

(1 shl (ap[c,i]-1));

p^.nrmut:=cr^.nrmut+1;

ultim^.urm:=p; ultim:=p

end;

for i:=1 to nr2[c] do

if (cr^.becuri

and

(1 shl (st[c,i]-1))<>0) and

(not ajuns[c, cr^.becuri-

(1 shl (st[c,i]-1))])

then

begin

ajuns[c, cr^.becuri-

(1 shl (st[c,i]-1))]:=true;

New(p); p^.urm:=nil; p^.pred:=cr;

p^.camera:=cr^.camera;

p^.becuri:=cr^.becuri-

(1 shl (st[c,i]-1));

p^.nrmut:=cr^.nrmut+1;

ultim^.urm:=p; ultim:=p;

if (c=n)and(p^.becuri=1 shl (n-1))

then

begin

cr:=p; gasitsolutie:=true;

Break

end

end;

if gasitsolutie then Break;

cr:=cr^.urm

end

End.

P059915: Peisaje

Andrei Vancea, student Universitatea Tehnică, Cluj

Problema este rezolvată prin programare dinamică.

Se definesc:

- a[i,j,1] - numărul de posibilități ca după trasarea a i caractere să se ajungă la înălțimea j și, în plus, condiția din enunț să fie îndeplinită (adică există cel puțin un munte cu înălțimea mai mare sau egală cu k);

- a[i,j,0] - numărul de posibilități ca după trasarea a i caractere să se ajungă la înălțimea j și condiția din enunț să nu fie îndeplinită.

Soluția problemei va fi a[2*n,0,1]. Valorile tabloului a se vor calcula în următorul mod:

dacă k=1

atunci a[1,1,1]=1

altfel a[1,1,1]=0

a[1,1,0]=1-a[1,1,1];

dacă j=k

atunci a[i,j,1]=a[i-1,j-1,0]+a[i-1,j-1,1]+

+a[i-1,j+1,1]

a[i,j,0]=0

dacă j<>k

atunci a[i,j,1]=a[i-1,j-1,1]+a[i-1,j+1,1];

a[i,j,0]=a[i-1,j-1,0]+a[i-1,j+1,0];

Listing: PEISAJE.PAS

{$M 16384,0,655360}

program peisaje;

var a:array[-1..62,-1..31,0..1] of Comp;

f:Text;

n,k,i,j:Byte;

Begin

Assign(f,'PEISAJ.IN'); Reset(f);

Readln(f,n,k);

Close(f); Fillchar(a,Sizeof(a),0);

if k=1

then a[1,1,1]:=1

else a[1,1,0]:=1;

for i:=2 to 2*n do

for j:=0 to n do

begin

if j=k

then a[i,j,1]:=a[i-1,j-1,0]+

a[i-1,j-1,1]+a[i-1,j+1,1]

else

begin

a[i,j,1]:=a[i-1,j-1,1]+a[i-1,j+1,1];

a[i,j,0]:=a[i-1,j-1,0]+a[i-1,j+1,0]

end

end;

Assign(f,'PEISAJ.OUT'); Rewrite(f);

Writeln(f,a[2*n,0,1]:0:0);

Close(f)

End.

P59923: Un dreptunghi

Andrei Vancea, student Universitatea Tehnică, Cluj

Pentru fiecare linie se contorizează numărul de bile aruncate despre care suntem informați că s-au întors și cele despre care ni se spune că nu s-au întors, apoi calculăm diferența acestora. Această diferență se va reține în șirul a. Problema se reduce la determinarea unei subsecvențe de sumă maximă din șirul a. Din extremitățile acelei subsecvențe se calculează valorile L și H. Dacă suma maximală calculată este negativă atunci H va fi 0. Același algoritm se aplică și pentru coloane, calculându-se C și W.

Listing: DREPTUNGHI.PAS

program dreptunghi;

type sir=array[1..20000] of Integer;

var l,c,h,w,m,n,q,r,i,k,b:Word;

a,s,pred:^sir;

f:Text;

Begin

New(a);

Fillchar(a^,Sizeof(a^),0);

New(s);

Fillchar(s^,Sizeof(s^),0);

New(pred);

Fillchar(pred^,Sizeof(pred^),0);

Assign(f,'DREPT.IN'); Reset(f);

Readln(f,m,n); Readln(f,q);

for i:=1 to q do

begin

Readln(f,k,b);

if b=0 then Dec(a^[k])

else Inc(a^[k])

end;

s^[1]:=a^[1];

pred^[1]:=1;

for i:=2 to m do

if s^[i-1]>=0

then

begin

s^[i]:=s^[i-1]+a^[i];

pred^[i]:=pred^[i-1]

end

else

begin

s^[i]:=a^[i];

pred^[i]:=i

end;

b:=1;

for i:=2 to m do

if (s^[b]<s^[i]) or ((s^[b]=s^[i])

and

(b-pred^[b]<i-pred^[i]))

then b:=i;

l:=pred^[b];

if s^[b]>=0 then h:=b-pred^[b]+1

else h:=0;

Fillchar(a^,Sizeof(a^),0);

Fillchar(s^,Sizeof(s^),0);

Fillchar(pred^,Sizeof(pred^),0);

Readln(f,r);

for i:=1 to r do

begin

Readln(f,k,b);

if b=0 then Dec(a^[k])

else Inc(a^[k])

end;

s^[1]:=a^[1];

pred^[1]:=1;

for i:=2 to m do

if s^[i-1]>=0

then

 

begin

s^[i]:=s^[i-1]+a^[i];

pred^[i]:=pred^[i-1]

end

else

begin s^[i]:=a^[i]; pred^[i]:=i end;

b:=1;

for i:=2 to m do

if (s^[b]<s^[i]) or ((s^[b]=s^[i])

and

(b-pred^[b]<i-pred^[i]))

then b:=i;

c:=pred^[b];

if s^[b]>=0 then w:=b-pred^[b]+1

else w:=0;

Close(f);

Assign(f,'DREPT.OUT'); Rewrite(f);

Writeln(f,l,' ', c,' ',h,' ',w);

Close(f)

End.

P059924: Submulțimi

Andrei Vancea, student Universitatea Tehnică, Cluj

Se traversează șirul și se marchează în tabloul a sumele ce se pot obține din submulțimi ale șirului cu elemente având indicele mai mic sau egal decât indicele elementului curent. Pentru fiecare sumă astfel marcată se reține elementul cu indice maxim al unei submulțimi având acea sumă. Dacă suma ce trebuie marcată a fost marcată înainte de a se ajunge la elementul curent înseamnă că s-a găsit o soluție și se afișează. Deoarece tabloul a are dimensiunea de 400000 de octeți (nu încape într-un segment de memorie) se reprezintă ca un șir de pointeri. Se observă că algoritmul funcționează mai rapid dacă șirul este ordonat crescător. De aceea se ordonează înainte.

Listing: SUBM.PAS

program submultimi;

type sir = array[0..49999] of Byte;

var a:array[1..30] of Longint;

s:array[0..7] of ^sir;

l1,l2,m,i:Byte;

j,max,maxx,k,suma:Longint;

sol1,sol2:array[1..30] of Byte;

procedure citire;

var f:Text;

i:Byte;

begin

Assign(f,'SUB.IN'); Reset(f);

Readln(f,m);

suma:=0;

for i:=1 to m do

begin

Read(f,a[i]);

Inc(suma,a[i])

end;

Close(f)

end;

procedure scriere;

var f:Text;

i:Byte;

begin

Assign(f,'SUB.OUT'); Rewrite(f);

Writeln(f,l1);

for i:=1 to m do

if sol1[i]=1 then Write(f,a[i], ' ');

Writeln(f);

Writeln(f,l2);

for i:=1 to m do

if sol2[i]=1 then Write(f,a[i],' ');

Writeln(f);

Close(f);

Halt

end;

procedure scrienu;

var f:Text;

begin

Assign(f,'SUB.OUT'); Rewrite(f);

Writeln(f,'NU');

Close(f);

Halt

end;

Begin

Citire;

for i:=0 to 7 do

begin

New(s[i]);

Fillchar(s[i]^,Sizeof(s[i]^),0)

end;

s[0]^[0]:=31;

max:=0;

for i:=1 to m-1 do

for j:=i+1 to m do

if a[i]>a[j]

then

begin

a[i]:=a[i] xor a[j];

a[j]:=a[i] xor a[j];

a[i]:=a[i] xor a[j]

end;

for i:=1 to m do

begin

Writeln(i);

maxx:=max;

for j:=0 to max do

if (s[j div 50000]^[j mod 50000]<>0) and

(s[j div 50000]^[j mod 50000]<>i)

then

begin

if s[(j+a[i]) div 50000]^[(j+a[i])

mod 50000]=0

then

begin

s[(j+a[i]) div 50000]^[(j+a[i])

mod 50000]:=i;

if (j+a[i]>maxx)

then maxx:=j+a[i];

end

else

begin

Fillchar(sol1,Sizeof(sol1),0);

Fillchar(sol2,Sizeof(sol2),0);

l1:=0;

l2:=0;

k:=j;

sol1[i]:= 1;

while k<>0 do

begin

sol1[s[k div 50000]^

[k mod 50000]]:=1;

Dec(k,a[s[k div 50000]^

[k mod 50000]])

end;

k:=j+a[i];

while k<>0 do

begin

sol2[s[k div 50000]^

[k mod 50000]]:=1;

Dec(k,a[s[k div 50000]^

[k mod 50000]])

end;

for k:=1 to m do

if (sol1[k]=1) and (sol2[k]=1)

then

begin

sol1[k]:=0;

sol2[k]:=0

end

else

if sol1[k]=1

then Inc(l1)

else

if sol2[k]=1

then Inc(l2);

scriere

end

end;

max:=maxx;

if max>suma div 2

then max:=suma div 2;

end;

scrienu

End.

[cuprins]