Cele mai bune solutii pentru problema "Algebra"
(ziua1, problema3)


Autorul problemei "Algebra si problemele ei" este Valentin Gheorghita, student, Politehnica Bucuresti, reprezentantul Romaniei la concursurile internationale.

Punctaj Maxim : 20 puncte

Solutii :
Daniel Opreanu - Alba - 7 puncte
Popa Alexandru - Bucuresti - 4 puncte;
Leu Tudor - Vrancea - 4 puncte;
Comisia Centrala
Fisierele de teste


Program realizat de elevul Daniel Opreanu - rezultat final : premiu II - 150 puncte

const semn:array[1..3]of char=('*','^','+');
type tttt=array[1..60]of 1..3;
var a:array[1..60]of integer;
    ff1,ff2,ff3:array[0..30,0..30]of byte;
    c:tttt;
    sol:array[0..30]of tttt;
    rezp:array[1..60]of integer;
    tmax,n,m,i,k,j:integer;
    fi:text;
    f:array[0..30]of boolean;
function f1(a,b:integer):integer;
begin
 f1:=(a*b)mod n;
end;
function ff(a,b:integer):integer;
var t,i:integer;
begin
 if b=0 then if a=0 then t:=0
                    else t:=1
        else begin
              t:=1;
              for i:=1 to b do
               t:=(t*(a mod n))mod n;
             end;
 ff:=t;
end;
function f2(a,b:integer):integer;
begin
 f2:=(ff(a,b)*ff(b,a))mod n;
end;
function min(a,b:integer):integer;
begin
 if a<b then min:=a
        else min:=b;
end;
function max(a,b:integer):integer;
begin
 if a<b then max:=b
        else max:=a;
end;
function f3(a,b:integer):integer;
var s,i:integer;
begin
 s:=0;
 for i:=min(a,b) to max(a,b) do
  s:=(s+i*i)mod n;
 f3:=s;
end;
procedure eval(p1,p2,l:integer);
var q,i,r:integer;
begin
 if l>tmax then tmax:=l;
 q:=a[p1];
 i:=p1;
 while (c[i] in [1..2])and(i<=p2) do
  begin
   case c[i] of
    1:q:=ff1[q,a[i+1]];
    2:q:=ff2[q,a[i+1]];
   end;
   inc(i);
  end;
 rezp[l]:=q;
 if i<=p2 then eval(i+1,p2,l+1);
end;
function eval2(k:integer):integer;
var q:integer;
begin
 q:=rezp[1];
 for i:=2 to k do
  q:=ff3[q,rezp[i]];
 eval2:=q;
end;
procedure memsol;
var v:integer;
begin
 tmax:=0;
 eval(1,m-1,1);
 v:=eval2(tmax);
 if not f[v] then begin
                   f[v]:=true;
                   sol[v]:=c;
                  end;
end;
procedure pune(k:integer);
var i:integer;
begin
 if k=m then memsol
        else for i:=1 to 3 do
               begin
                c[k]:=i;
                pune(k+1);
               end;
end;
begin
 assign(fi,'algebra.in');
 reset(fi);
 assign(output,'algebra.out');
 rewrite(output);
 readln(fi,n,m);
 for i:=1 to m do
  read(fi,a[i]);
 for i:=1 to n do
  f[i]:=false;
 for i:=0 to n do
  for j:=0 to n do
   ff1[i,j]:=f1(i,j);
 for i:=0 to n do
  for j:=0 to n do
   ff2[i,j]:=f2(i,j);
 for i:=0 to n do
  for j:=0 to n do
   ff3[i,j]:=f3(i,j);
 pune(1);
 k:=0;
 for i:=0 to n-1 do
  if f[i] then inc(k);
 writeln(k);
 for i:=0 to n-1 do
  if f[i] then begin
                write(i,'=',a[1]);
                for j:=1 to m-1 do
                 write(semn[sol[i,j]],a[j+1]);
                writeln;
               end;
 close(output);
 assign(output,'');
 rewrite(output);
end.

[BACK]


Program realizat de Valentin Gheorghita membru al comisiei centrale a Olimpiadei Nationale de Informatica

program expresie;
type op=^mat;
     mat=array[0..30,0..30] of byte;
     el=^matr;
     matr=array[0..30,0..30] of string[60];
     modif=array[0..30,0..30] of boolean;

var p : el;
    n : matr;
    baza,nr : byte;
    numar : array[1..61] of byte;
    f : text;
    op1,op2,op3 : mat;
    m,mp : modif;

procedure init;
 var i,j,k,nr : integer;
 begin
  for i:=0 to 30 do
   for j:=0 to 30 do
    op1[i,j]:=(i*j) mod baza;
  for i:=1 to 30 do
   for j:=1 to 30 do
    begin
     op2[i,0]:=0;
     op2[0,j]:=0;
     nr:=1;
     for k:=1 to i do
      nr := (nr mod baza) * j;
     for k:=1 to j do
      nr := (nr mod baza) * i;
     op2[i,j] := nr mod baza;
    end;
  for i:=0 to 30 do
   for j:=0 to 30 do
    begin
     nr:=0;
     if i<j then for k:=i to j do nr:=nr+k*k
            else for k:=j to i do nr:=nr+k*k;
     op3[i,j] := nr mod baza;
    end;
  new(p);
  for i:=0 to baza do
   for j:=0 to baza do
    begin
     m[i,j]:=false;
     mp[i,j]:=false;
    end;
 end;

procedure citire;
 var i: byte;
 begin
  assign(f,'algebra.in');
  reset(f);
  readln(f,baza,nr);
  for i:=1 to nr do read(f,numar[i]);
  close(f);
 end;

procedure calcul;
 var i,j,k : integer;
 begin
  for i:=0 to 30 do
   for j:=0 to 30 do
     p^[i,j]:='';
  p^[0,op1[numar[1],numar[2]]]:='*';
  p^[0,op2[numar[1],numar[2]]]:='^';
  p^[numar[1],numar[2]]:='+';
  m[numar[1],numar[2]]:=true;
  for k:=3 to nr do
   begin
    for j:=0 to baza do
     for i:=0 to baza do
      begin
       n[i,j]:='';
       mp[i,j]:=false;
      end;
    for i:=0 to baza do
     for j:=0 to baza do
      begin
       if p^[i,j]<>'' then
           begin
            if m[i,j] then begin
                             n[op3[i,j],numar[k]]:=p^[i,j]+'+';
                             mp[op3[i,j],numar[k]]:=true;
                             end
                       else begin
                             n[j,numar[k]]:=p^[i,j]+'+';
                             mp[j,numar[k]]:=true;
                            end;
            n[i,op1[j,numar[k]]]:=p^[i,j]+'*';
            mp[i,op1[j,numar[k]]]:=m[i,j];
            n[i,op2[j,numar[k]]]:=p^[i,j]+'^';
            mp[i,op2[j,numar[k]]]:=m[i,j];
           end;
      end;
    p^:=n;
    m:=mp;
   end;
 end;

procedure scrie(s:string;n:integer);
 var i:integer;
 begin
  write(f,n,'=');
  for i:=1 to nr-1 do
   write(f,numar[i],s[i]);
  writeln(f,numar[nr]);
 end;

procedure tiparire;
 var i,j,k,nr : integer;
     test : boolean;
 begin
  assign(f,'algebra.out');
  rewrite(f);
  nr:=0;
  for i:=0 to baza-1 do
   begin
    test:=false;
    for j:=0 to baza-1 do
     for k:=0 to baza-1 do
      if m[j,k]
       then begin if (p^[j,k]<>'') and (op3[j,k]=i) then test:=true ; end
       else if (p^[j,k]<>'') and (k=i) then test:=true;
    if test then inc(nr);
   end;
  writeln(f,nr);
  for i:=0 to baza-1 do
   begin
    test:=false;
    for j:=0 to baza-1 do
     for k:=0 to baza-1 do
      if (((p^[j,k]<>'') and (op3[j,k]=i) and not(test) and m[j,k]) or
         ((p^[j,k]<>'') and (k=i) and not(test) and not(m[j,k])))
         then begin
               test:=true;
               scrie(p^[j,k],i);
              end;
   end;
  close(f);
 end;

procedure done;
 begin
  dispose(p);
 end;

begin
 citire;
 if nr=1 then begin
               assign(f,'algebra.out');
               rewrite(f);
               writeln(f,1);
               writeln(f,numar[1],'=',numar[1]);
               close(f);
	       halt;
              end;
 init;
 calcul;
 tiparire;
 done;
end.

[BACK]


 

 

Fisierele de teste :

Test 1 :
30 2
17 12

Test 2 :
12 7
8 6 11 2 4 3 5

Test 3 :
15 15
10 12 6 3 8 13 10 5 8 0 11 8 9 8 4

Test 4 :
27 24
24 26 22 25 5 18 26 20 25 21 25 19 4 25 2 20 20 22 2 2 11 8 22 5

Test 5 :
23 34
10 17 7 12 6 16 0 19 22 8 8 10 9 0 13 20 15 7 1 10 22 9 13 12 21 11 1 13 18 15 8 10 6 1

Test 6 :
7 50
4 3 3 0 3 3 4 1 5 6 1 5 1 2 5 6 4 5 0 0 3 5 5 3 5 0 2 1 2 6 2 0 4 4 4 6 0 0 5 4 0 1 0 1 0 1 2 3 1 0

Test 7 :
30 60
7 21 23 1 28 11 13 28 2 10 25 16 16 15 0 1 15 15 5 20 21 18 26 25 23 1 11 25 6 23 26 22 26 16 24 5 1 26 24 10 5 16 11 29 8 17 17 1 27 12 23 18 5 20 13 13 13 26 25 1

Test 8 :
30 60
22 12 5 0 3 21 17 15 16 3 26 15 29 12 5 18 25 28 19 8 7 5 27 26 11 12 14 9 1 4 29 28 24 5 14 20 18 14 9 26 25 6 19 12 28 29 2 18 5 14 3 7 7 18 29 27 22 19 8 4

Test 9 :
30 60
1 2 3 4 5 1 2 3 4 5 1 2 3 4 5 1 2 3 4 5 1 2 3 4 5 1 2 3 4 5 1 2 3 4 5 1 2 3 4 5 1 2 3 4 5 1 2 3 4 5 1 2 3 4 5 1 2 3 4 5

[BACK]