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.

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.

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)

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

(e[exp[i]]=false)

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)

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

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

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

end;

vec:=i;

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

i<=Length(exp))

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]:='*'

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

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]

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.

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).

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')

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)

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)

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

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.

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.

{$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.

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).

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

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

begin Write(semn[sem]);

sem:=neg(sem)

end;

sem:=neg(sem);

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

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.

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.

{$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)

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)

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

end

end;

begin

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

if cr=

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

(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)

(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

(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

(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.

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];

{$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.

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.

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

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

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

end

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])

(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

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

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

end

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])

(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.

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.

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

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

if sol1[k]=1

then Inc(l1)

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]