Tin học Thuật toán

H

hongnhung.97

nvtan256 said:
cho a,b. tìm c lớn nhất sao cho a^c là ước của b!. ai có thuật toán giúp mình với!
a,b<=30000
Bấm để xem đầy đủ nội dung ...

:-?... Mình không vào được pascal nên không thể thử ~~> Không thể mày mò được :((. Nhưng mình nghĩ trong này ta sẽ dùng đến: B mod a^c = 0, max, phương pháp tìm ước chung lớn nhất bằng pascal... Có điều chưa biết giá trị của c thì khó thật... Mình sẽ cố khắc phục lỗi máy sớm nhất để thử mò mẫm bài này... Bài này hay lắm :x

P.s Nếu ai tìm ra thuật toàn post lên cho mình tham khảo với :x
 
N

nvtan256

hongnhung.97 said:


:-?... Mình không vào được pascal nên không thể thử ~~> Không thể mày mò được :((. Nhưng mình nghĩ trong này ta sẽ dùng đến: B mod a^c = 0, max, phương pháp tìm ước chung lớn nhất bằng pascal... Có điều chưa biết giá trị của c thì khó thật... Mình sẽ cố khắc phục lỗi máy sớm nhất để thử mò mẫm bài này... Bài này hay lắm :x

P.s Nếu ai tìm ra thuật toàn post lên cho mình tham khảo với :x
Bấm để xem đầy đủ nội dung ...
bạn có cách ko dùng ưcln ko, tôi thử dùng cách đó rồi, mặc dù đúng nhưng nó chạy quá 1s nên ko đạt yêu cầu.
 
N

nvtan256

hongnhung.97 said:


:-?... Mình không vào được pascal nên không thể thử ~~> Không thể mày mò được :((. Nhưng mình nghĩ trong này ta sẽ dùng đến: B mod a^c = 0, max, phương pháp tìm ước chung lớn nhất bằng pascal... Có điều chưa biết giá trị của c thì khó thật... Mình sẽ cố khắc phục lỗi máy sớm nhất để thử mò mẫm bài này... Bài này hay lắm :x

P.s Nếu ai tìm ra thuật toàn post lên cho mình tham khảo với :x
Bấm để xem đầy đủ nội dung ...
Const fi='Maxnum.inp';
fo='Maxnum.out';
Var n,p:integer;
dem,i,j:longint;
k:longint;
a:integer;
function ucln(x,y:integer):integer;
begin
while x<>y do
if x<y then y:=y-x
else x:=x-y;
ucln:=x;
end;
BEGIN
Assign(input,fi); reset(input);
Assign(output,fo); rewrite(output);
readln(n,p);
close(input);
j:=1;
for i:=1 to n do
begin
k:=i;
a:=ucln(p,k);
while a<>1 do
begin
j:=j*a;
if j mod p=0 then
begin
inc(dem);
j:=j div p;
end;
k:=k div a;
a:=ucln(k,p);
end;
end;
writeln(dem);
close(output);
END.
code này chạy hơn 1s.
 
K

kakashi168

dễ thấy a=1 thì c=oo
phân tích a thành thừa số nguyên tố [TEX] a=x1^{p1}...xn^{pn}[TEX] với mỗi thừa số nguyên tố x trong a một thì dò từ 1->b thì tìm k max sao cho số đó=x^k .... gọi sl là số lượng mũ đối với mỗi x thì kq=min(sl1 div p1,sl2 div p2,..., sln div pn) ko đến một giây!!![/TEX]
 
Last edited by a moderator:
W

wind_naruto

Hờ, cái thuật toán thì bạn Hông nhung đã nói thì tớ thấy ược ucln của b ko chắc đã =a^c, mĩnh sẽ trình bày code, sai thì lên tiếng nhá. Tớ cho thằng b! chia cho a sau dó a^1..a^c khi nào thằng b! chia mà dư thì dừng lại
mình nghĩ bài làm của mình cũng ko hay lém nhưng vẫn ra kết quả đúng:
Mã: 
Program nvtan256;
uses crt;
var a,b,c,kqgt:longint;
Function giaithua(n:integer):longint;
  begin
    if n=0 then giaithua:=1
       else giaithua:=giaithua(n-1)*n;
  end;
Procedure solve(x:integer; y:longint);
  var k:integer; t:longint;
    begin
      k:=y mod x;
      if k=0 then
        begin
          c:=c+1;

          t:=trunc(y/x);
          solve(a,t);
        end
        else exit;
    end;
Begin clrscr;
  Write('a,b= '); Readln(a,b);
  c:=0;
  kqgt:=giaithua(b);
  solve(a,kqgt);
  Write('c= ',c);
  Readln;
End.
 
W

wind_naruto

kakashi168 said:
dễ thấy a=1 thì c=oo
a khác một thì dò từ 1->b với mỗi số kiểm tra xem số đó có chia hết cho a ko, nếu chia hết thì chia đến bao nhiêu ..... (kiểu như phân tích một số thành thừa số nguyên tố)
ko đến một giây!!!
Bấm để xem đầy đủ nội dung ...

ÔI trời ông định chạy đến b! sao.........................
 
W

wind_naruto

kakashi168 said:
biết dùng đến hàm mà ko nhận ra rằng mình sai cơ bản???
thử a=30000,b=30000 thì kq có đúng ko vậy??
kiểu longint mới chỉ khoảng 2 tỉ thôi ;))



chạy đến b bạn à, có nhìn rõ ko thế ???
Bấm để xem đầy đủ nội dung ...
Ờ đúng roài để xem lại, tôi mới thử mấy giá trí đầu thôi thanks
Const fi='Maxnum.inp';
fo='Maxnum.out';
Var n,p:integer;
dem,i,j:longint;
k:longint;
a:integer;
function ucln(x,y:integer):integer;
begin
while x<>y do
if x<y then y:=y-x
else x:=x-y;
ucln:=x;
end;
BEGIN
Assign(input,fi); reset(input);
Assign(output,fo); rewrite(output);
readln(n,p);
close(input);
j:=1;
for i:=1 to n do
begin
k:=i;
a:=ucln(p,k);
while a<>1 do
begin
j:=j*a;
if j mod p=0 then
begin
inc(dem);
j:=j div p;
end;
k:=k div a;
a:=ucln(k,p);
end;
end;
writeln(dem);
close(output);
Bấm để xem đầy đủ nội dung ...
Sao minh thử file maxnum.inp là 3 6
thì cho ra kết quả maxnum.out là 1
mình thấy 6!=720 chia hết cho 3^2 mà
 
W

wind_naruto

kakashi168 said:
dễ thấy a=1 thì c=oo
a khác một thì dò từ 1->b với mỗi số kiểm tra xem số đó có chia hết cho a ko, nếu chia hết thì chia đến bao nhiêu ..... (kiểu như phân tích một số thành thừa số nguyên tố)
ko đến một giây!!!
Bấm để xem đầy đủ nội dung ...
Ờ ông thử code lun để mọi người tham khảo đê....@-)
 
N

nvtan256

thử 6 3 in ra 2 mà bạn, chỉ có điều ko chạy đc số quá to => sai
cái j ấy nó có thể vượt quá cả qword chứ mình lại khai longint chả thấm!
 
Last edited by a moderator:
N

nvtan256

có lẽ phải dùng mảng đánh đấu các ước của a khi duyệt từ 1-->b, ví dụ f[2]=3 nghĩa là từ 1-->b thì b! chia hết cho 2^3 và 2 là 1 ước của a, sau tìm min các f rồi cộng f[a] . nhưng đây mứi là ý tưởng thôi, mai tính tiếp, buồn ngủ quá.
 
N

nvtan256

11thanhkhoeo said:
Phân tich a ra thừa số nguyên tố x1..xk

cho i chạy tư 1-> b

đếm xem có bao nhiêu i chia hết cho x1->xk( nếu : hết thì xem có chia hết cho xk^2... hay không)

Sô nhỏ nhất là c
Bấm để xem đầy đủ nội dung ...
in ra kq đúng thì đc nhưng quan trọng là thời gian chỉ 1s
code của mình chạy quá lâu nè
test 30000 30000 nó chạy mô đến khoảng 2s thì phải


nhập b a
PHP: 
Uses math;
Const fi='';//'Maxnum.inp';
      fo='';//'Maxnum.out';

Var n,p:integer;
    dem:integer;
    tich:qword;
    t:longint;
    kt:integer;
    a,b:array[0..30000] of longint;
Procedure Nhap;
Begin
        Assign(input,fi); reset(input);
        Assign(output,fo); rewrite(output);
        readln(n,p);
        close(input);
End;
Procedure Solve;
Var k:integer;
    i:integer;
    j:integer;
Begin
   for i:=1 to n do
        begin
                k:=i;
                for j:=2 to min(p,i) do
                        if (p mod j=0) and (k mod j=0) then
                        while k mod j=0 do
                        begin
                                inc(a[j]);
                                k:=k div j;
                        end;
        end;
End;
Procedure Ghi;
Var  i,k:integer;
     j:longint;
Begin
        k:=p;   j:=maxlongint;
        for i:=2 to k do
                if (p mod i=0) then
                while p mod i=0 do
                begin
                        inc(b[i]);
                        p:=p div i;
                end;
        begin
                for i:=1 to k do
                        if (a[i]<>0) and (b[i]<>0) and (j>a[i] div b[i]) then j:=a[i] div b[i];
                        if j<>maxlongint then writeln(j) else writeln(0);
        end;
        close(output);
End;
BEGIN
        Nhap;
        Solve;
        Ghi;
END.
 
Last edited by a moderator:
You must log in or register to reply here.
Top Bottom