Разложение числа на простые множители... Опции

[ACC]

задача - разложить число на простые множители. не могу продумать алгоритм.

Код

uses   crt;
var   a,b,c,i,j:integer;
begin
clrscr;
writeln('vvedite   chislo');
readln(a);
c:=a;
i:=1;
repeat
if a mod i <> 0 then begin writeln (i); b:=i;
inc(i);
???!!!!!!???
end;
until   i=a;
readln;
end.

там вместо вопр\воскл. знаков надо вставить нечто, что раскладывало бы число b на те же простые множители, потом вновь возвращаемся к начальному числу, ищем следующее... рекурсия наверное, да вот присобачить её не получается...


фак и поиск не помог(

[volvo]

На кой тебе здесь рекурсия?

Все замечательно делается и без нее:

procedure Factorization(x: word);
var i: word;

 procedure DivX; { делим на простое число, пока делится без остатка }
 begin
      while (x>1) and (x mod i = 0) do
      begin
           write(i:4);
           x:= x div i;
      end;
 end;

begin
     i:=2;
     DivX;
     i:=3;
     while (i < x div 2) do
     begin
           DivX;
           inc(i,2); { <=> i:=i+2; только нечётные числа }
     end;
     if x>1 then writeln(x:4);
end;

begin
  Factorization(20);
end.

© Romtek

[$rvr4vr]

А как тут можно сделать порядок множителей? Я вот как думаю может поместить множители в массив потом подсчитать количество идущих подряд одинаковых. но как то это не очень получается.

[volvo]

Организуй массив типа:

array [1 .. n] of record
  mult: integer;
  power: integer;
end;

и во время (или вместо) печати значений, проходи по массиву и если текущий множитель = arr[k].mult, то увеличивай arr[k].power...

[$rvr4vr]

Получилось вот так:

uses
crt;
const
n=50  ;
var
k:integer;
f:array  [1..n] of record
   mult:integer;
   power:integer;
end;

procedure Factorization(x: word);
var i: word;
 procedure DivX;
 var l,s:word;
 begin
    l:=1;
      while (x>1) and (x mod i = 0) do
      begin
           f[l].mult:=i;
           x:= x div i;
           if i=f[l].mult then
             inc(f[l].power)
             else inc(l);
      end;
      for s:=1 to l do
        begin
         write(f[s].mult:4,'  ');
         writeln(f[s].power);
        end;
 end;
begin
     i:=2;
     DivX;
     i:=3;
     while (i < x div 2) do
     begin
           DivX;
           inc(i,2);
     end;
     if x>1 then writeln(x:4);
   end;

begin
  clrscr;
  readln(k);
  Factorization(k);
  readln;
end.
 

но при некоторых числах выдает на первых парах нули. ненаю как с этим бороться

[volvo]

Так проверь с теми же числами:

uses crt;

const n = 50;
var
  k: integer;
  f: array  [1..n] of record
    mult:integer;
    power:integer;
  end;

procedure add_to_array(i: integer);
var
  j: word;
  found: boolean;
begin
  found := false; j := 1;
  while (j <= n) and (f[j].mult > 0) and (not found) do
    if f[j].mult = i then begin
      inc(f[j].power); found := true;
    end
    else inc(j);

  if not found then begin
    f[j].mult := i; f[j].power := 1;
  end;

end;

procedure Factorization(x: word);
var i: word;

  procedure DivX;
  begin

    while (x>1) and (x mod i = 0) do
    begin
      add_to_array(i);
      x:= x div i;
    end;

  end;

begin
     i:=2;
     DivX;
     i:=3;
     while (i < x div 2) do
     begin
           DivX;
           inc(i,2);
     end;
     if x>1 then add_to_array(x)
   end;

begin
  clrscr;
  readln(k);
  Factorization(k);

  k := 1;
  while (k <= n) and (f[k].mult > 0) do begin
    writeln(f[k].mult, '^', f[k].power);
    inc(k);
  end;
  readln;
end.

[$rvr4vr]

Отлично! работает коректно, в отличии от моей версии