IPB
ЛогинПароль:

> Прочтите прежде чем задавать вопрос!

1. Заголовок темы должен быть информативным. В противном случае тема удаляется ...
2. Все тексты программ должны помещаться в теги [code=pas] ... [/code], либо быть опубликованы на нашем PasteBin в режиме вечного хранения.
3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали!
4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора).
5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM!
6. Одна тема - один вопрос (задача)
7. Проверяйте программы перед тем, как разместить их на форуме!!!
8. Спрашивайте и отвечайте четко и по существу!!!

 
 Ответить  Открыть новую тему 
> Разложение числа на простые множители...
сообщение
Сообщение #1





Группа: Пользователи
Сообщений: 3
Пол: Мужской

Репутация: -  0  +


задача - разложить число на простые множители. не могу продумать алгоритм.
Код
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 на те же простые множители, потом вновь возвращаемся к начальному числу, ищем следующее... рекурсия наверное, да вот присобачить её не получается...


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


--------------------
Не умеешь думать - работай!

ICQ: 332207947
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #2


Гость






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

Все замечательно делается и без нее:
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
 К началу страницы 
+ Ответить 
сообщение
Сообщение #3


Пионер
**

Группа: Пользователи
Сообщений: 51
Пол: Мужской
Реальное имя: Серж

Репутация: -  0  +


А как тут можно сделать порядок множителей? Я вот как думаю может поместить множители в массив потом подсчитать количество идущих подряд одинаковых. но как то это не очень получается.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #4


Гость






Организуй массив типа:
array [1 .. n] of record
mult: integer;
power: integer;
end;

и во время (или вместо) печати значений, проходи по массиву и если текущий множитель = arr[k].mult, то увеличивай arr[k].power... smile.gif
 К началу страницы 
+ Ответить 
сообщение
Сообщение #5


Пионер
**

Группа: Пользователи
Сообщений: 51
Пол: Мужской
Реальное имя: Серж

Репутация: -  0  +


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

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.



но при некоторых числах выдает на первых парах нули. ненаю как с этим бороться
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #6


Гость






Так проверь с теми же числами:
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.

 К началу страницы 
+ Ответить 
сообщение
Сообщение #7


Пионер
**

Группа: Пользователи
Сообщений: 51
Пол: Мужской
Реальное имя: Серж

Репутация: -  0  +


Отлично! работает коректно, в отличии от моей версии
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 





- Текстовая версия 29.03.2024 22:00
500Gb HDD, 6Gb RAM, 2 Cores, 7 EUR в месяц — такие хостинги правда бывают
Связь с администрацией: bu_gen в домене octagram.name