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: ExpresieSabă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: NasturiSabă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 BalcaniSabă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: SemneSabă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: VileAndrei 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: PeisajeAndrei 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 dreptunghiAndrei 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țimiAndrei 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] |