CTNOWN - Bội số chung nhỏ nhất

Tác giả: ll931110

Ngôn ngữ: Pascal

{$MODE DELPHI,N+}
program CTNOWN;
const
  input  = '';
  output = '';
  maxn = 350;
  maxk = 500;
  maxd = 3;
  base = 1000000;
  maxv = 1000000;
var
  F: array[0..maxn,0..maxk] of extended;
  trace: array[0..maxn,0..maxk] of integer;
  d: array[1..maxd] of integer;
  list: array[1..maxk] of integer;
  fi,fo: text;
  n,nlist: integer;
  i,nTest: integer;

procedure openfile;
begin
  assign(fi, input);
    reset(fi);

  assign(fo, output);
    rewrite(fo);
end;

function prime(x: integer): boolean;
var
  i: integer;
begin
  for i := 2 to trunc(sqrt(x)) do if x mod i = 0 then exit(false);
  prime := true;
end;

procedure solve;
var
  i,j,t: integer;
begin
  nlist := 0;
  for i := 2 to maxn do if prime(i) then
    begin
      inc(nlist);
      list[nlist] := i;
    end;

  fillchar(F, sizeof(F), 0);
  for j := 1 to nlist do
    for i := 2 to maxn do
      begin
       F[i,j] := F[i,j - 1];
       trace[i,j] := i;

       t := list[j];
       while i >= t do
         begin
           if F[i,j] < F[i - t,j - 1] + ln(t) then
             begin
               F[i,j] := F[i - t,j - 1] + ln(t);
               trace[i,j] := i - t;
             end;
           t := t * list[j];
         end;
      end;
end;

procedure mul(x: integer);
var
  i: integer;
begin
  if x = 0 then exit;
  for i := 1 to maxd do d[i] := d[i] * x;
  for i := 1 to maxd - 1 do if d[i] >= base then
    begin
      d[i + 1] := d[i + 1] + d[i] div base;
      d[i] := d[i] mod base;
    end;
end;

procedure printresult;
var
  i,u,k,s,tmp: integer;
  st: string;
  max: extended;
begin
  readln(fi, n);
  max := 0;
  u := 0;
  for i := 1 to maxk do
    if max < F[n,i] then
      begin
        max := F[n,i];
        u := i;
      end;

  fillchar(d, sizeof(d), 0);
  d[1] := 1;
  s := n;

  for k := u downto 1 do
    begin
      tmp := trace[s,k];
      mul(s - tmp);
      s := tmp;
    end;

  s := maxd;
  while d[s] = 0 do dec(s);

  write(fo, d[s]);
  for i := s - 1 downto 1 do
    begin
      str(d[i],st);
      for k := 1 to 6 - length(st) do write(fo, 0);
      write(fo, st);
    end;
  writeln(fo);
end;

procedure closefile;
begin
  close(fo);
  close(fi);
end;

begin
  openfile;
  solve;

  readln(fi, nTest);
  for i := 1 to nTest do printresult;

  closefile;
end.

Download