Форум: "Потрепаться";
Текущий архив: 2002.05.30;
Скачать: [xml.tar.bz2];
ВнизОчередная несложная разминка Найти похожие ветки
← →
MBo (2002-04-15 18:03) [0]Тренировка для начинающих.
Составить программу разложения целых чисел, скажем, до 10000 на множители
пример вывода
2=prime
3=prime
4=2*2
...
10000=2*2*2*2*5*5*5*5 или 10000=2^4*5^4 по вкусу
← →
Андрей Сенченко (2002-04-15 18:49) [1]Например в таком направлении ?
X := исходное число
For i := 1 to 9 do
begin
IF X div Y = X / Y // -> сохраняем Y в массив решений, переназначаем результат в X
Else BREAK
IF X = 1 BREAK
end;
← →
Андрей Сенченко (2002-04-15 18:51) [2]По хорошему, цикл не
to 9, а to X/2 наверное
← →
Blackweber (2002-04-15 19:14) [3]unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls,math;
type
TForm1 = class(TForm)
Edit1: TLabeledEdit;
Edit2: TLabeledEdit;
Button1: TButton;
Label1: TLabel;
Label2: TLabel;
procedure Button1Click(Sender: TObject);
end;
var
Form1: TForm1; e:integer;st:string;
a:array[1..100] of real;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
begin
st:=""; e:=0; edit2.Text:="";
a[1]:=strtofloat(edit1.Text);
repeat
inc(e);
a[e+1]:=trunc(log2(a[e]));
a[e+2]:=a[e]-power(2,a[e+1]);
st:=st+"2^"+floattostr(a[e+1])+" + ";
a[e+1]:=a[e+2];
until a[e+2]=0;
delete(st,length(st)-2,3);
edit2.Text:=st;
end;
end.
← →
Mystic (2002-04-15 23:34) [4]Уже загадывал, но хорошей тренировкой будет программа на Delphi (консольная), которая выведет на экран собственный исходник (доступ к pas файлу запрещен, в ресурсы ничего не пихать и т. д.)
← →
Doom (2002-04-15 23:38) [5]Задачки такие а ыв школе на бейсике делал помню.
> Андрей Сенченко © (15.04.02 18:51)
> По хорошему, цикл не
> to 9, а to X/2 наверное
Цикл до SQRT(X)
← →
MBo (2002-04-16 06:52) [6]>Blackweber
это совсем не то - твоя процедура составляет число из степеней двойки. Замечу, что эта задача для двоек решается махом, стоит только вспомнить представление чисел в компе. Для другого основания твой способ с исправлениями в общем-то подходит.
← →
Alx2 (2002-04-16 08:00) [7]Довольно объемный код, но заточенный под скорость.
Const
PrimetblSize = 100; // Из-за разумных ограничений объема цитируемости таблицы, делаем ее размер = 100. Но здесь реально лучше использовать 10000. Иначе выигрыш по скорости незначителен.
Const
PrimeTable: Array[1..PrimetblSize] Of Integer = (
2, 3, 5, 7, 11, 13, 17, 19, 23, 29, 31, 37, 41, 43, 47, 53, 59, 61, 67, 71,
73, 79, 83, 89, 97, 101, 103, 107, 109, 113, 127, 131, 137, 139, 149, 151, 157, 163, 167, 173,
179, 181, 191, 193, 197, 199, 211, 223, 227, 229, 233, 239, 241, 251, 257, 263, 269, 271, 277, 281,
283, 293, 307, 311, 313, 317, 331, 337, 347, 349, 353, 359, 367, 373, 379, 383, 389, 397, 401, 409,
419, 421, 431, 433, 439, 443, 449, 457, 461, 463, 467, 479, 487, 491, 499, 503, 509, 521, 523, 541);
Function isPrime(A: Integer): Boolean; Forward;
Procedure Divide(A, B: Integer; Var C, D: Integer); Assembler; Stdcall; // C=A div B; D = A mod B. Т.е. используем приятную особенность операции деления, позволяющую одновременно найти частное и остаток.
asm
mov eax,a
cdq
idiv b
mov ecx,c
mov [ecx],eax
mov ecx,d
mov [ecx],edx
end;
Function SearchNearestPrime(Pattern: Integer): Integer;
Function Search(Start, Stop: Integer): Integer;
Var C: Integer;
Begin
If Start < Stop Then
Begin
C := (Start + Stop) Shr 1;
If PrimeTable[C] < Pattern Then
Result := Search(C + 1, Stop) Else
If PrimeTable[C] > Pattern Then
Result := Search(Start, C - 1)
Else
Result := C;
End
Else
If Start > Stop Then
Result := Stop Else
Result := Start
End;
Begin
Result := Search(1, PrimetblSize);
End;
Function PrevPrime(A: Integer): Integer;
Begin
If (A > 2) And (A <= PrimeTable[PrimetblSize]) Then
Begin
Result := SearchNearestPrime(A);
If PrimeTable[Result] >= A Then Result := PrimeTable[Result - 1]
Else Result := PrimeTable[Result];
End
Else
If A <= 2 Then Result := 2
Else
Begin
dec(A);
If A And 1 = 0 Then dec(A);
While Not isPrime(A) Do dec(A, 2);
Result := A;
End;
End;
Function isPrime(A: Integer): Boolean;
Var K: Integer;
Begin
If A < 0 Then A := -A;
Result := (A <= 2) Or (PrimeTable[SearchNearestPrime(A)] = A);
If Not Result Then
Begin
Result := ((A And 1) = 1);
If Result
Then
Begin
K := PrevPrime(Round(Sqrt(A)) + 1);
While (K > 2) And (A Mod K <> 0) Do K := PrevPrime(K);
Result := K = 2;
End;
End;
End;
весь сыр-бор здесь:
После отработки iFactor List содержит разложение на простые множители числа A.
Procedure iFactor(A: Integer; Lst: TList);</n>
Var
K : Integer;
M, R: Integer;
Begin
If A < 0 Then A := -A;
Lst.Clear;
If (A <= 2) Or (isPrime(A)) // Если A - простое, то нечего и раскладывать
Then
Lst.Add(Pointer(A))
Else
Begin
K := PrevPrime(Round(Sqrt(A)) + 1); // Находим ближайшее с низу к квадратному корню из A простое число.
While (K > 2) Do
Begin
Divide(A, K, M, R); // M = A div K; R = A mod K
If (R = 0) Then // Если поделилось нацело,
Begin // то продолжаем деление далее
Repeat
Lst.Add(Pointer(K));
A := M;
Divide(A, K, M, R);
Until (R <> 0);
K := Round(Sqrt(A)) + 1
End;
K := PrevPrime(K);
End;
If A And 1 = 0 Then // если A четное
Begin // то дополняем List двойками
Repeat
Lst.Add(Pointer(2));
A := A shr 1; // Делим A на два
// asm
// shr A,1
// end;
Until (A And 1) = 1; // Выходим, если A нечетное
End;
If (A > 1)
Then
Lst.Add(Pointer(A));
End;
End;
← →
Alx2 (2002-04-16 08:13) [8]Да, чуть не забыл описать идею:
Раскладывая число A, замечаем, что если A непростое, то наибольший член в разложении не превысит Round(Sqrt(A)) + 1.
Находим этот член, делим на него A и все повторяем снова. В итоге количество итераций O(log2(A))
← →
MBo (2002-04-16 08:31) [9]OK, работает очень быстро.
← →
Nemesis (2002-04-16 09:50) [10]Alx2 © (16.04.02 08:00)
Const
PrimeTable: Array[1..PrimetblSize] Of Integer = (
2, 3, 5, 7, 11, 13, 17, 19, 23, 29, 31, 37, 41, 43, 47, 53, 59, 61, 67, 71,
73, 79, 83, 89, 97, 101, 103, 107, 109, 113, 127, 131, 137, 139, 149, 151, 157, 163, 167, 173,
179, 181, 191, 193, 197, 199, 211, 223, 227, 229, 233, 239, 241, 251, 257, 263, 269, 271, 277, 281,
283, 293, 307, 311, 313, 317, 331, 337, 347, 349, 353, 359, 367, 373, 379, 383, 389, 397, 401, 409,
419, 421, 431, 433, 439, 443, 449, 457, 461, 463, 467, 479, 487, 491, 499, 503, 509, 521, 523, 541);
А автоматически расчитать все простые числа в некотором диапазоне слабо ...
← →
MBo (2002-04-16 10:07) [11]не слабо ;)
вот глупый код
var
X: array [1..10000] of Boolean;
procedure ResetNoPrimes;
var
I, J: Integer;
begin
FillChar(X, SizeOf(X), True);
for I := 2 to 100 do
for J := I to 5000 do
if I * J <= 10000 then
X[I * J] := False;
end;
← →
Nemesis (2002-04-16 10:17) [12]MBo © (16.04.02 10:07)
не слабо ;)
А почему там не вставил
← →
igorr (2002-04-16 11:14) [13]To MBo, Alx2: А что значит быстро?
Предлагаю так.
type
TForm1 = class(TForm)
Edit1: TEdit;
Button1: TButton;
Label1: TLabel;
procedure Button1Click(Sender: TObject);
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.Button1Click(Sender: TObject);
var
Num, Simple:Integer;
Str:String;
begin
Num:=StrToInt(Edit1.Text);
Str:=Edit1.Text+"=";
Simple:=2;
while Num<>1 do begin
if Num Mod Simple = 0
then begin
Num:=Num Div Simple;
Str:=Str+IntToStr(Simple)+" * ";
Continue;
end
else Inc(Simple);
end;
Delete(Str,Length(Str)-2,3);
Label1.Caption:=Str;
end;
end.
← →
Alx2 (2002-04-16 11:55) [14]>Nemesis © (16.04.02 09:50)
>А автоматически расчитать все простые числа
>в некотором диапазоне слабо ...
Ты думаешь я их не автоматически искал? :))
← →
igorr (2002-04-16 12:06) [15]Виноват. Континью - лишняя.
← →
MBo (2002-04-16 13:18) [16]>igorr
ОК, работает
>А что значит быстро
числа от 2 до 10000 махом раскладывает
мой вариант намного медленнее, правда, он полностью функционально закончен, в него вывод встроен внутрь, что и тормозит, кроме того, простые насчитываются по ходу дела и хранятся (я его пока не приводил)
← →
MBo (2002-04-22 09:18) [17]приведу свой вариант
procedure TForm1.Button2Click(Sender: TObject);
var
PrList:Tlist;
MulList:TStringList;
i,Num,Temp,MaxPrime:integer;
s:string;
N:integer;
begin
N:=10000;
PrList:=Tlist.Create;
PrList.Capacity:=100;
MulList:=TStringList.Create;
MulList.Capacity:=N;
for Num:=2 to N do begin
Temp:=Num;
MaxPrime:=2;
s:=IntToStr(Temp)+"=";
i:=-1;
while (Temp >= MaxPrime) and (i<PrList.Count-1) do begin
inc(i);
while (Temp >= MaxPrime) and (Temp mod Integer(PrList[i])=0) do begin
MaxPrime:=Integer(PrList[i]);
Temp:=Temp Div MaxPrime;
s:=s+IntToStr(MaxPrime)+"*";
end;
end;
if Temp=Num then begin
PRList.Add(Pointer(Num));
s:=s+"Prime";
end
else Delete(s,Length(s),1);
MulList.add(s);
end;
PrList.Free;
MulList.SaveToFile("C:\Primes.txt");
MulList.Free;
end;
Страницы: 1 вся ветка
Форум: "Потрепаться";
Текущий архив: 2002.05.30;
Скачать: [xml.tar.bz2];
Память: 0.5 MB
Время: 0.005 c