Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Потрепаться";
Текущий архив: 2004.01.16;
Скачать: [xml.tar.bz2];

Вниз

У кого есть код, генератора чисел?   Найти похожие ветки 

 
IronHawk   (2003-12-11 12:39) [0]

Генератор 4х-значных чисел, сумма знаков которых = 14!


 
Sandman25   (2003-12-11 12:45) [1]

3 for.


 
zzet   (2003-12-11 12:46) [2]

У меня. Меняю на код генератора 4х-значных чисел, сумма знаков которых = 16!


 
Alex_Bredin   (2003-12-11 12:52) [3]

for i:=1000 to 9500 (:)) do
if (сумма знаков = 14) then ...

с вас 10$


 
Романов Р.В.   (2003-12-11 12:53) [4]

Генерируй знаки по очереди


 
Digitman   (2003-12-11 13:19) [5]

))
как всегда - в своем амплуа) ... неисправим)))


 
IronHawk   (2003-12-11 13:20) [6]

Ну чё, посмеялись?
Вот и хорошо, а теперь по делу ПЛЗ!


 
Виктор Щербаков   (2003-12-11 13:27) [7]

IronHawk © (11.12.03 13:20) [6]
А по делу - Alex_Bredin © (11.12.03 12:52) [3]


 
Sandman25   (2003-12-11 13:32) [8]

const S = 14;

for i1 := 0 to 9 do
for i2 := 0 to min(S - i1, 9) do
for i3 := 0 to min(S-i1-i2, 9) do
begin
i4 := S - i1 - i2 - i3;
if i4 in [0..9] then
// ура
end;


 
Sandman25   (2003-12-11 13:33) [9]

Даже лучше вместо if i4 in [0..9] написать if i4 <= 9


 
Sandman25   (2003-12-11 13:36) [10]

const S = 14;

for i1 := 0 to 9 do
for i2 := 0 to min(S - i1, 9) do
for i3 := S-i1-i2 to min(S-i1-i2, 9) do
begin
i4 := S - i1 - i2 - i3;
// ура
end;


 
NailMan   (2003-12-11 13:38) [11]

Делаешь что-то вроде http://arbuz.uz/x_mindreader.html

?


 
Sandman25   (2003-12-11 13:45) [12]

const S = 14;

for i1 := 0 to 9 do
for i2 := 0 to min(S - i1, 9) do
for i3 := min(max(S-i1-i2-9,0),9) to min(S-i1-i2, 9) do
begin
i4 := S - i1 - i2 - i3;
// ура
end;


 
MBo   (2003-12-11 14:09) [13]

прикольно ;)
procedure TForm1.Button1Click(Sender: TObject);
procedure NextDigit(Digits, Level, Sum: Integer);
var i: integer;
begin
if Level > 4 then begin
Memo1.Lines.Add(IntToStr(Digits));
Exit;
end;
for i := (Ord(Level = 1) + Ord(Level = 4) * (14 - Sum)) to Min(14 - Sum, 9) do
NextDigit(Digits * 10 + i, Level + 1, Sum + i);
end;
begin
NextDigit(0, 1, 0);
end;


 
REA   (2003-12-11 14:47) [14]

Табличка подойдет?


 
ISP   (2003-12-11 15:31) [15]

NailMan © (11.12.03 13:38) [11]
>Делаешь что-то вроде http://arbuz.uz/x_mindreader.html

Sorry за офтор, но как ета хрень работает, т.е. алгоритм. Может кто понял?


 
Sandman25   (2003-12-11 15:40) [16]

procedure TForm1.Button1Click(Sender: TObject);
const S = 14;
StartNumber = 0;
EndNumber = 9;
var
i1, i2, i3, i4: integer;
begin
for i1 := max(S-EndNumber*3, StartNumber) to min(S-StartNumber*3, EndNumber) do
for i2 := max(S-i1-EndNumber*2, StartNumber) to min(S-i1-StartNumber*2, EndNumber) do
for i3 := max(S-i1-i2-EndNumber*1, StartNumber) to min(S-i1-i2-StartNumber*1, EndNumber) do
begin
i4 := S-i1-i2-i3;
memo1.lines.add(
IntToStr(i1)+
IntToStr(i2)+
IntToStr(i3)+
IntToStr(i4));
end;


 
Alex_Bredin   (2003-12-11 15:42) [17]

всегда получаюца числа, кратные 9 - у них у всех одинаковые символы- каждый раз они меняются


 
ISP   (2003-12-11 15:45) [18]

Alex_Bredin © (11.12.03 15:42) [17]
;))) понял, во тормознул ;)))


 
Magisimus   (2003-12-11 15:53) [19]

Всё намного проще...

var i,max:byte
ch:array[1..4] of byte;

....

max:=14;
for i:=1 to 4 do begin
ch[i]:=random(max)+1;
dec(max,ch[i]);
end;

В результате массив ch и содерржит нужные числа, дальше расставляй их в любом порядке;)

С вас 100$ за короткое решение;)))


 
Mike Kouzmine   (2003-12-11 16:58) [20]

procedure TForm1.Button1Click(Sender: TObject);
function SumInt(S : Integer) : Integer;
var
St : String;
I : Integer;
begin
St := IntToStr(S);
Result := 0;
for I := 1 to Length(St) do
Result := Result + StrToInt(String(St[I]))
end;

var
I : Integer;
begin
Gauge1.MinValue := 59;
Gauge1.MaxValue := 9500;
Gauge1.Progress := 0;
for I := 59 to 9500 do
begin
if SumInt(I) = 14 then Memo1.Lines.Add(IntToStr(I));
Gauge1.Progress := Gauge1.Progress + 1;
Application.ProcessMessages;
end;
end;


 
stream   (2003-12-11 17:38) [21]

2 Magisimus © (11.12.03 15:53) [19]
>> max:=14;
>> for i:=1 to 4 do begin
>> ch[i]:=random(max)+1;
>> dec(max,ch[i]);
>> end;

Ваш массив действительно будет содержать такие числа, но
1) они будут храниться в 14-ичной системе счисления
2) они не будут равномерно распределены на множестве всех
таких чисел

Генерировать можно так:
repeat
sum:=random(9501);
until (sum mod 10)+((sum div 10)mod 10)+((sum div 100)mod 10)+
(sum div 1000)=14;

Этот алгоритм далеко не оптимален, но числа он генерирует неплохо


 
IronHawk   (2003-12-11 18:46) [22]


> MBo © (11.12.03 14:09) [13]

Отлично!
И без отрицательных чисел!

> Sandman25 © (11.12.03 15:40) [16]

А на кой отрицательные?

> Mike Kouzmine © (11.12.03 16:58) [20]

Круто, но часть чифр состоит не из 4-х знаков!!!


 
Sandman25   (2003-12-11 18:52) [23]

[22] IronHawk © (11.12.03 18:46)

Какие еще отрицательные?
Я же проверял.


 
Magisimus   (2003-12-12 09:05) [24]

Придумал!

var i,sum:integer;
r:array[1..4] of integer;

...

sum:=14;
For i:=1 to 4 do begin
r[i]:=random(10-((sum div 10)+(sum mod 10)));

{ или сюда r[i]:=random(((sum div 10)+(sum mod 10)));}

dec(sum,r[i]);
end;


 
IronHawk   (2003-12-12 13:17) [25]


> Magisimus © (12.12.03 09:05) [24]

:-))))
:=random
:-))))


 
Magisimus   (2003-12-13 22:00) [26]


> IronHawk © (12.12.03 13:17) [25]
>
> > Magisimus © (12.12.03 09:05) [24]
>
> :-))))
> :=random
> :-))))

???? а что не так? Почему не :=random? Нам же нужен генератор чисел...


 
Magisimus   (2003-12-15 16:56) [27]

UP!


 
Карелин Артем   (2003-12-15 17:08) [28]

Слабо сделать гнератор 3-значных цифирок, сумма которых находится в пределах от 5 до 14 и прибавлять к ним четвертую цифру, сами знаете по какому принципу.


 
stream   (2003-12-15 17:46) [29]

>Magisimus © (12.12.03 09:05) [24]
А вы проверяли его работоспособность? У меня он не работает - в слысле, выдает неверные результаты. Теоретически, такой алгоритм может выдать результат "0000".


 
Mike Kouzmine   (2003-12-15 17:52) [30]

Карелин Артем © (15.12.03 17:08) [28] Надо генерить одну цифру, а затем добавлять три, сами знаете по какому принципу.


 
Vlad Oshin   (2003-12-15 18:16) [31]

Ну ыт даешь...
а еще чего можешь?


 
Dimka Maslov   (2003-12-15 18:37) [32]

Вот работающий алгоритм для генирования последовательности цифр с заданными длиной и суммой (пишется за пол-часа, если начать думать)

function RndGen(Sum, Len: Integer): string;
// Sum - требуемая сумма цифр
// Len - длина строки
var
i, N, K: Integer;
Ch: Char;
begin
Result := "";
if Sum >= Len * 9 then Exit; // чтобы не зацикливалось если сгенерировать число нельзя

for i := 1 to Len - 1 do begin // генерируем все цифры, кроме последней
if Sum = 0 then Result := Result + "0";
if Sum > 9 then N := Random(10) else N := Random(Sum);
Result := Result + IntToStr(N);
Sum := Sum - N;
end;

if Sum = 0 then Result := Result + "0"; // сумма уже достаточна - добавляем ноль

if Sum <= 9 then Result := Result + IntToStr(Sum) else begin // сумма меньше девяти, добавляем остаток
Result := Result + "9"; // больше девяти - размазываем недостачу
Sum := Sum - 9;
while Sum > 0 do begin
N := 1 + Random(Len - 1);
if Result[N] <> "9" then Result[N] := Char(Ord(Result[N]) + 1) else Continue;
Dec(Sum);
end;
end;

for i := 1 to Len do begin // перемешаем цифры
N := 1 + Random(Len);
K := 1 + Random(Len);
Ch := Result[N];
Result[N] := Result[K];
Result[K] := Ch;
end;

while Result[1] = "0" do begin // если не хотим, чтобы число начиналось с нуля
Delete(Result, 1, 1);
Result := Result + "0";
end;
end;


Желающие отблагодарить прораммиста за его нелёгкий труд могут высылать некоторую сумму мылом :)


 
Dimka Maslov   (2003-12-15 18:47) [33]

строку
if Sum = 0 then Result := Result + "0"
можно убрать, она лишняя


 
Sandman25   (2003-12-15 18:48) [34]

[32] Dimka Maslov © (15.12.03 18:37)

Получаются последовательности не намного лучше этой:

Result := "";
if Sum > Len*9 then exit;
while Sum >= 9 do
begin
Result := Result + "9";
Sum := Sum - 9;
Dec(Len);
end;
Result := Result + IntToStr(Sum);
Dec(Len);
while Len > 0 do
begin
Result := Result + "0";
Dec(Len);
end;


 
Dimka Maslov   (2003-12-15 18:53) [35]

>Sandman25 © (15.12.03 18:48) [34]

А где здесь генератор?


 
Sandman25   (2003-12-15 18:57) [36]

Я имел ввиду, что постоянно получается так, что сначала идут 1-2 большие цифры (8,9), а потом куча нулей.


 
Dimka Maslov   (2003-12-15 19:00) [37]

>Sandman25 © (15.12.03 18:57) [36]
Тогда какой смысл в таком "генераторе". Я слабо представляю, для чего это вообще надо, но всё равно желательно, чтобы распределение цифр было равномерным, а не только нули и большие цифры (в этом случае задача не имеет здравого смысла, если она вообще его имеет)


 
Dimka Maslov   (2003-12-15 19:10) [38]

Да, и не забываем вызывать Randomize


 
wnew   (2003-12-15 19:24) [39]

А кстати, что там с теорией случайных чисел? Где можно почитать об этом? Почему-то в поисковиках ничего путёвого не нашёл.
Вот интересная статистика розыгрышей 6 из 49 в Германии за этот год: http://www.wnew.de/Lotto1_49_1.png
и с 9.10.55 и по конец этого года: http://www.wnew.de/Lotto1_49_2.png.

Слева шкала - колличество выпадений шаров. Внизу номера шаров.


 
Magisimus   (2003-12-15 21:54) [40]


> >Magisimus © (12.12.03 09:05) [24]
> А вы проверяли его работоспособность? У меня он не работает
> - в слысле, выдает неверные результаты. Теоретически, такой
> алгоритм может выдать результат "0000".

Да проверял, но извиняюсь не то выложил...

var i,sum:integer;
r:array[1..4] of integer;

...

sum:=14;
For i:=1 to 3 do begin
r[i]:=random(10-((sum div 10)+(sum mod 10)));

{или сюда r[i]:=random(((sum div 10)+(sum mod 10)));}

dec(sum,r[i]);
end;
r[4]:=sum mod 10;
inc(r[random(3)+1],sum-r[4]);


Вот это почти тоже самое,но работает всегда. Я просто скопировал не то... Извиняюсь...



Страницы: 1 2 вся ветка

Форум: "Потрепаться";
Текущий архив: 2004.01.16;
Скачать: [xml.tar.bz2];

Наверх




Память: 0.53 MB
Время: 0.009 c
14-49713
McSimm
2003-12-26 10:50
2004.01.16
« По Вашим письмам »


3-49403
Alex-kosmonavt
2003-12-16 18:42
2004.01.16
Редактор справочников


1-49527
lipskiy
2003-12-17 23:13
2004.01.16
Прокрутка колесом мыши


1-49558
Ciber
2004-01-06 06:39
2004.01.16
RichEdit


6-49663
postx
2003-11-14 22:35
2004.01.16
Как узнать, существует ли e-mail?





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский