Forum strony www.multipasko.pl [Regulamin]


Dodaj wpis w tym temacie
Spis tematów
Login:

Hasło:
Strona: 1 2 ... 555 556 557 558 559 560 561
Wyślij wiadomość do admina

Przewiń wpisy ↓

moje ... oprogramowanie

2025-04-30 (22:01)

status kostka1zn
Data rejestracji: 2021-02-25
Ilość postów: 3154

16333
wpis nr 1 563 927
[ CZCIONKA MONOSPACE ]

Dziękuję.
Pobrałem sobie następny twój plik.

No to chyba teraz kolega Scenic jest w ekstazie.
Ma już wszystko co mu jest potrzebne.
2025-04-30 (22:12)

status MultiTest
Data rejestracji: 2020-08-05
Ilość postów: 6113

16235
wpis nr 1 563 929
[ CZCIONKA MONOSPACE ]

Scenic,
Sprawdziłem bazę Keno z podanego z linku który podałeś.
Jest tam trochę błędów, zdublowane losowania, losowania puste gdzie zamiast liczb występują same zera,
wymienione po kolei:

0354213 19-10-2013 14:35 01 02 04 05 06 10 12 21 23 27 33 35 36 38 39 41 63 66 68 70 00
0354214 19-10-2013 14:40 04 05 07 08 09 12 16 23 24 26 27 29 31 38 39 56 57 66 67 69 00
0354214 19-10-2013 14:40 04 05 07 08 09 12 16 23 24 26 27 29 31 38 39 56 57 66 67 69 00
0354215 19-10-2013 14:45 14 16 18 19 25 26 29 34 41 42 45 46 48 49 51 55 56 61 66 67 00

zmieniono na :
0354213 19-10-2013 14:35 01 02 04 05 06 10 12 21 23 27 33 35 36 38 39 41 63 66 68 70 00
0354214 19-10-2013 14:40 04 05 07 08 09 12 16 23 24 26 27 29 31 38 39 56 57 66 67 69 00
0354215 19-10-2013 14:45 14 16 18 19 25 26 29 34 41 42 45 46 48 49 51 55 56 61 66 67 00
=======================================================================================



0354652 21-10-2013 21:30 07 08 16 17 19 21 26 30 31 36 37 42 46 48 51 52 58 63 64 70 00
0354653 22-10-2013 06:45 01 07 11 15 17 21 25 30 36 37 40 41 42 45 48 54 62 63 64 70354654 22-10-2013 06:50 03 05 07 08 12 23 31 33 34 37 38 39 43 46 47 49 54 57 58 65 00
//błędny zapis linii, nieobsłużony właściwie (za duża liczba i data zamiast liczby) może być nawet przyczyną dużych błędów

zmieniono na:
0354652 21-10-2013 21:30 07 08 16 17 19 21 26 30 31 36 37 42 46 48 51 52 58 63 64 70 00
0354653 22-10-2013 06:45 01 07 11 15 17 21 25 30 36 37 40 41 42 45 48 54 62 63 64 70 00
0354654 22-10-2013 06:50 03 05 07 08 12 23 31 33 34 37 38 39 43 46 47 49 54 57 58 65 00
=======================================================================================


0442986 02-03-2015 10:30 05 06 16 27 30 31 33 35 44 48 52 53 57 58 60 61 65 67 68 69 00
0442986 02-03-2015 10:30 05 06 16 27 30 31 33 35 44 48 52 53 57 58 60 61 65 67 68 69 00
//zdublowane losowania
//brak losowania następnego
0442988 02-03-2015 10:40 02 03 15 17 25 26 27 33 36 38 43 48 51 52 58 61 62 63 67 68 00

zmieniono na :
0442986 02-03-2015 10:30 05 06 16 27 30 31 33 35 44 48 52 53 57 58 60 61 65 67 68 69 00
0442987 02-03-2015 10:35 07 08 11 13 14 18 20 21 22 24 27 28 36 38 41 45 47 59 60 61 00
0442988 02-03-2015 10:40 02 03 15 17 25 26 27 33 36 38 43 48 51 52 58 61 62 63 67 68 00
=======================================================================================

Ilość losowań : 1375846
1375847
440449 16-02-2015 06:45
====== Brak liczb w losowaniu =======

440459 16-02-2015 07:35
====== Brak liczb w losowaniu =======

440470 16-02-2015 08:30
====== Brak liczb w losowaniu =======

440484 16-02-2015 09:40
====== Brak liczb w losowaniu =======

440498 16-02-2015 10:50
====== Brak liczb w losowaniu =======

440504 16-02-2015 11:20
====== Brak liczb w losowaniu =======

440508 16-02-2015 11:40
====== Brak liczb w losowaniu =======

440521 16-02-2015 12:45
====== Brak liczb w losowaniu =======

479071 20-09-2015 21:15
====== Brak liczb w losowaniu =======

479080 21-09-2015 07:10
====== Brak liczb w losowaniu =======

479083 21-09-2015 07:25
====== Brak liczb w losowaniu =======

482864 12-10-2015 11:00
====== Brak liczb w losowaniu =======

482874 12-10-2015 11:50
====== Brak liczb w losowaniu =======

483294 14-10-2015 17:10
====== Brak liczb w losowaniu =======

483311 14-10-2015 18:35
====== Brak liczb w losowaniu =======

483312 14-10-2015 18:40
====== Brak liczb w losowaniu =======

483317 14-10-2015 19:05
====== Brak liczb w losowaniu =======

483318 14-10-2015 19:10
====== Brak liczb w losowaniu =======

483339 14-10-2015 20:55
====== Brak liczb w losowaniu =======

483341 14-10-2015 21:05
====== Brak liczb w losowaniu =======

483345 14-10-2015 21:25
====== Brak liczb w losowaniu =======

1049365 23-11-2021 23:54
====== Brak liczb w losowaniu =======

1052491 06-12-2021 08:02
====== Brak liczb w losowaniu =======

1052492 06-12-2021 08:06
====== Brak liczb w losowaniu =======

1052493 06-12-2021 08:10
====== Brak liczb w losowaniu =======

1052494 06-12-2021 08:14
====== Brak liczb w losowaniu =======

1052495 06-12-2021 08:18
====== Brak liczb w losowaniu =======

1052496 06-12-2021 08:22
====== Brak liczb w losowaniu =======

1052497 06-12-2021 08:26
====== Brak liczb w losowaniu =======

1054812 14-12-2021 23:26
====== Brak liczb w losowaniu =======

1054813 14-12-2021 23:30
====== Brak liczb w losowaniu =======

1054814 14-12-2021 23:34
====== Brak liczb w losowaniu =======

1054815 14-12-2021 23:38
====== Brak liczb w losowaniu =======

1054816 14-12-2021 23:42
====== Brak liczb w losowaniu =======

1054817 14-12-2021 23:46
====== Brak liczb w losowaniu =======

1054818 14-12-2021 23:50
====== Brak liczb w losowaniu =======

1054819 14-12-2021 23:54
====== Brak liczb w losowaniu =======

razem 37 losowań bez liczb
======================================

Część z tych losowań zostało uzupełnionych.
Jeżeli chcesz kompletną naprawioną baza do 30.04.2025 włącznie mogę wrzucić do pobrania,
a najlepiej by było żeby te poprawki zostało uwzględnione u źródła, przez właściciela strony.

--- wpis edytowano 2025-04-30 22:14 ---

2025-04-30 (22:44)

status MultiTest
Data rejestracji: 2020-08-05
Ilość postów: 6113

16235
wpis nr 1 563 943
[ CZCIONKA MONOSPACE ]

Scenic,
Jeżeli interesują Ciebie liczby zimne i gorące z Keno podawane na bieżąco przez AI to można spróbować z programikiem Keno_Rotacja_GorąceZimne.
10 liczb na próbę, na podstawie losowań do numeru 1376612 z godz.22:42

34,64,25,9,56,30,63,38,31,53

2025-06-14 (14:49)

status BochiCintra
Data rejestracji: 2019-07-29
Ilość postów: 103

16005
wpis nr 1 568 982
[ CZCIONKA MONOSPACE ]

Cześć, przekonwertowałem program lottodesigner Nicka Koutrasa na Delphi, działa, ale wymaga udoskonalenia, w linku znajduje się plik .exe i kod źródłowy

}}
2025-06-14 (14:50)

status BochiCintra
Data rejestracji: 2019-07-29
Ilość postów: 103

16005
wpis nr 1 568 983
[ CZCIONKA MONOSPACE ]

https://www.mediafire.com/file/dzd6ps1f1vk5d33/lottodesigner_-_1.zip/file
2025-07-04 (19:09)

status vidmo
Data rejestracji: 2004-11-03
Ilość postów: 12804

449
wpis nr 1 571 021
[ CZCIONKA MONOSPACE ]

Witaj Leo. Czy mógłbyś "podrasować" swoim softem ten schemacik?

C(70,28,8,20)=8 - 100%
C(70,28,2x 8,20)=8 - 99,993449%
C(70,28,3x 8,20)=8 - 99,938261%
C(70,28,8x 8,20)=8 - 99,24155%
C(70,28,9,20)=8 - 99,235427%
C(70,28,2x 9,20)=8 - 95,978477%
C(70,28,6x 9,20)=8 - 85,137422%
C(70,28,10,20)=8 - 85,114775%
C(70,28,2x 10,20)=8 - 64,647534%
C(70,28,7x 10,20)=8 - 29,749756%
C(70,28,19,20)=8 - 0,000002%

01 03 04 05 06 07 08 09 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 28 29 33
02 03 04 05 07 08 09 11 12 13 14 15 16 18 20 24 25 26 27 29 30 31 32 33 34 37 41 42
01 04 05 06 07 08 09 10 13 17 18 19 21 22 23 24 25 26 27 28 30 34 35 36 38 39 40 42
01 02 03 06 10 11 12 14 15 16 17 19 20 21 22 23 28 29 31 32 33 35 36 37 38 39 40 41
29 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 56 57 61
30 31 32 33 35 36 37 39 40 41 42 43 44 46 48 52 53 54 55 57 58 59 60 61 62 65 69 70
29 32 33 34 35 36 37 38 41 45 46 47 49 50 51 52 53 54 55 56 58 62 63 64 66 67 68 70
29 30 31 34 38 39 40 42 43 44 45 47 48 49 50 51 56 57 59 60 61 63 64 65 66 67 68 69
2025-07-05 (01:56)

status vidmo
Data rejestracji: 2004-11-03
Ilość postów: 12804

449
wpis nr 1 571 058
[ CZCIONKA MONOSPACE ]

Witaj ponownie Leo. Jak już się rozpędzisz, to może i ten ulepszysz...

C(80,28,4x 7,20)=8 - 100%
C(80,28,8,20)=8 - 99,808504%
C(80,28,2x 8,20)=8 - 97,860738%
C(80,28,3x 8,20)=8 - 93,749808%
C(80,28,8x 8,20)=8 - 87,113325%
C(80,28,9,20)=8 - 87,113307%
C(80,28,9,20)=8 - 81,85808%
C(80,28,2x 9,20)=8 - 65,934026%
C(80,28,10,20)=8 - 50,236704%
C(80,28,2x 10,20)=8 - 25,814962%
C(80,28,5x 10,20)=8 - 19,962052%
C(80,28,18,20)=8 - 0,000004%

01 03 04 05 06 07 08 09 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 28 29 33
02 03 04 05 07 08 09 11 12 13 14 15 16 18 20 24 25 26 27 29 30 31 32 33 34 37 41 42
01 04 05 06 07 08 09 10 13 17 18 19 21 22 23 24 25 26 27 28 30 34 35 36 38 39 40 42
01 02 03 06 10 11 12 14 15 16 17 19 20 21 22 23 28 29 31 32 33 35 36 37 38 39 40 41
39 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 66 67 71
40 41 42 43 45 46 47 49 50 51 52 53 54 56 58 62 63 64 65 67 68 69 70 71 72 75 79 80
39 42 43 44 45 46 47 48 51 55 56 57 59 60 61 62 63 64 65 66 68 72 73 74 76 77 78 80
39 40 41 44 48 49 50 52 53 54 55 57 58 59 60 61 66 67 69 70 71 73 74 75 76 77 78 79
2025-08-03 (09:52)

status 777ch
Data rejestracji: 2005-11-07
Ilość postów: 22780

1386
wpis nr 1 574 412
[ CZCIONKA MONOSPACE ]

Witka
Czasem zaglądam
i ..zamykam 🫣
2025-08-03 (16:11)

status vidmo
Data rejestracji: 2004-11-03
Ilość postów: 12804

449
wpis nr 1 574 441
[ CZCIONKA MONOSPACE ]

Witaj Leo.
Jakbyś mógł przemienić swoją maszynką te 28 ósemki, bo tylko Ty masz do tego soft.
2025-08-03 (16:33)

status 777ch
Data rejestracji: 2005-11-07
Ilość postów: 22780

1386
wpis nr 1 574 443
[ CZCIONKA MONOSPACE ]

Sorry Vidmo
Nie mielę chwilowo niczego. 🤭

Coś mi się kojarzy
.. mianowicie fakt
że w historii Multi Multi
tylko 6-zestawów wystarczało
do trafienia co najmniej 1x 8/20
jakieś 4x w 25- letniej historii Multi
te 6-zestawów nie uzyskało minimum 8/20
czyli raz na 6-lat 🤭
Ale nie mam tych danych ,
już skasowane..
pamiętam ,że kilka miesięcy temu
to sprawdzałem.

--- wpis edytowano 2025-08-03 16:41 ---

2025-08-03 (17:20)

status vidmo
Data rejestracji: 2004-11-03
Ilość postów: 12804

449
wpis nr 1 574 447
[ CZCIONKA MONOSPACE ]

Witaj
Ok, ale jakby się kiedyś skończyło to " chwilowo " to pamiętaj o mnie...
2025-08-03 (20:43)

status BochiCintra
Data rejestracji: 2019-07-29
Ilość postów: 103

16005
wpis nr 1 574 457
[ CZCIONKA MONOSPACE ]

Cześć, konwertuję kod źródłowy „cover32.c” z nummela na pascal.

program CombinatoricalOptimization;

{$mode objfpc}{$H+}

uses
Math, SysUtils;

const
MAXV = 100;
EXPSIZE = 2000;
MAXKSETCOUNT = High(Integer);
MAXRANDOM = High(Integer);

type
TIntArray = array of Integer;
TFloatArray = array of Double;
TBinCoefArray = array[0..MAXV, 0..MAXV+1] of Integer;

var
{ Global variables }
kset: TIntArray;
neighborLen: Integer;
coverLen: Integer;
coveredLen: Integer;
neighbors: TIntArray;
coverings: TIntArray;
covered: TIntArray;
costs: TIntArray;
costds: TIntArray;
iterCounter: Integer;
endT: Double;

binCoef: TBinCoefArray;
exps: TFloatArray;
neglibleExp: Double;
coolFact: Double;
initProb: Double;
v, k, t, m, b: Integer;
testCount: Integer;
restrictedNeighbors: Integer;
initialT: Double;
frozen: Integer;
endLimit: Integer;
apprexp: Integer;
Tset: Integer;
L: Integer;
Lset: Integer;
LFact: Double;
localOpt: Integer;
onTheFly: Integer;
coverNumber: Integer;
solX: Integer;
memoryLimit: Integer;
searchB: Integer;
SBFact: Double;
pack: Integer;
check: Integer;
verbose: Integer;
setNumber: Integer;
nextS: Integer;
// stored: array[0..1] of Integer;
currSto: Integer;
nextSto: Integer;
storedPtr: array[0..1] of TIntArray;

function OverflowBinCoef(vVal, kVal: Integer): Boolean;
begin
Result := binCoef[vVal, kVal] = 0;
end;

function MinVal(X, Y: Integer): Integer;
begin
if X < Y then Result := X else Result := Y;
end;

function MaxVal(X, Y: Integer): Integer;
begin
if X > Y then Result := X else Result := Y;
end;

function ApprExpProb(R: Double): Double;
begin
if R > neglibleExp then
Result := 0.0
else
Result := exps[Round(R / neglibleExp * EXPSIZE + 0.5)];
end;

function ExpProb(R: Double): Double;
begin
if apprexp <> 0 then
Result := ApprExpProb(R)
else
Result := Exp(-R);
end;

function Random01: Double;
begin
Result := Random / MAXRANDOM;
end;

function BinCoef1(n, kVal: Integer): Integer;
var
i: Integer;
K: Integer;
nCk: Double;
begin
if kVal > n then
begin
Result := 0;
Exit;
end;
if kVal = n then
begin
Result := 1;
Exit;
end;

N := n;
K := kVal;
nCk := 1.0;

for i := 0 to kVal - 1 do
nCk := nCk * (N - i) / (K - i);

Result := Round(nCk);
end;

function Factorial(nValue: Double): Double;
var
pc: Double;
begin
Result := nValue;
pc := nValue;
while pc > 2 do
begin
Result := Result * (pc - 1);
pc := pc - 1;
end;
end;

procedure CalculateExps;
var
i: Integer;
neglibleProb: Double;
begin
neglibleProb := 1.0 / EXPSIZE;
neglibleExp := -Ln(neglibleProb);

SetLength(exps, EXPSIZE + 1);
for i := 0 to EXPSIZE do
exps[i] := Exp(-i / EXPSIZE * neglibleExp);
end;

procedure BIs(bl: Integer);
begin
b := bl;
if b > 100 then
begin
{ Handle error }
WriteLn('Error: b exceeds maximum');
Exit;
end;

SetLength(kset, b);
SetLength(costs, b + 1);
SetLength(costds, b + 1);
end;

function NewBAfterSuccess(oldB: Integer): Integer;
var
lb: Integer;
begin
lb := Round(SBFact * oldB + 0.5);
if lb = oldB then
lb := lb - 1;
Result := lb;
end;

procedure AllocateMemory;
var
elemCountNeighbors, elemCountCoverings, elemCountCovered: Integer;
i, tmp: Integer;
begin
elemCountNeighbors := 0;
elemCountCoverings := 0;
elemCountCovered := 0;

neighborLen := k * (v - k);

if v > MAXV then
begin
WriteLn('Error: v exceeds maximum');
Exit;
end;

tmp := 0;
coverLen := 0;
for i := 0 to MinVal(k - t, m - t) do
begin
coverLen := coverLen + BinCoef1(k, t + i) * BinCoef1(v - k, m - t - i);
if coverLen < tmp then
begin
WriteLn('Error: coverLen overflow');
Exit;
end;
tmp := coverLen;
end;
coverLen := coverLen + 1;

if onTheFly = 0 then
begin
elemCountNeighbors := neighborLen * BinCoef1(v, k);
elemCountCoverings := coverLen * BinCoef1(v, k);
end
else
elemCountCoverings := coverLen * 2;

elemCountCovered := BinCoef1(v, m);
coveredLen := elemCountCovered;

if (memoryLimit > 0) and
(elemCountNeighbors * 4 + elemCountCoverings * 4 + elemCountCovered * 4 > memoryLimit) then
begin
WriteLn('Error: Memory limit exceeded');
end
else
begin
if elemCountNeighbors > 0 then
SetLength(neighbors, elemCountNeighbors);
SetLength(coverings, elemCountCoverings);
SetLength(covered, elemCountCovered);
end;
end;

procedure MakeComplement(var s, c: TIntArray; vVal: Integer);
var
sPtr, cPtr, i: Integer;
begin
sPtr := 0;
cPtr := 0;

for i := 0 to vVal - 1 do
begin
if (sPtr < Length(s)) and (s[sPtr] = i) then
Inc(sPtr)
else
begin
c[cPtr] := i;
Inc(cPtr);
end;
end;
c[cPtr] := MAXV + 1;
end;

procedure GetFirstSubset(var subset: TIntArray; card: Integer);
var
i: Integer;
begin
for i := 0 to card - 1 do
subset[i] := i;
subset[card] := MAXV + 1;
end;

function GetNextSubset(var subset: TIntArray; card, vVal: Integer): Boolean;
var
j, i: Integer;
begin
if subset[0] >= vVal - card then
begin
Result := False;
Exit;
end;

j := 0;
while (j + 1 < card) and (subset[j + 1] <= subset[j] + 1) do
Inc(j);

Inc(subset[j]);
for i := 0 to j - 1 do
subset[i] := i;

Result := True;
end;

procedure UnrankSubset(rank: Integer; var subset: TIntArray; card: Integer);
var
mVal, i, p: Integer;
begin
mVal := rank;
for i := card - 1 downto 0 do
begin
p := i;
while BinCoef1(p + 1, i + 1) <= mVal do
Inc(p);
mVal := mVal - BinCoef1(p, i + 1);
subset[i] := p;
end;
end;

function RankSubset(var subset: TIntArray; card: Integer): Integer;
var
rank, i: Integer;
begin
rank := 0;
for i := 0 to card - 1 do
rank := rank + BinCoef1(subset[i], i + 1);
Result := rank;
end;

procedure CalculateNeighbors;
var
subset, csubset, subsubset, subcsubset, mergeset: TIntArray;
nptr, r, ssptr, scptr, mptr, i: Integer;
begin
SetLength(subset, MAXV + 1);
SetLength(csubset, MAXV + 1);
SetLength(subsubset, MAXV + 1);
SetLength(subcsubset, MAXV + 1);
SetLength(mergeset, MAXV + 1);

nptr := 0;
GetFirstSubset(subset, k);

for r := 0 to BinCoef1(v, k) - 1 do
begin
MakeComplement(subset, csubset, v);
GetFirstSubset(subsubset, k - 1);

repeat
GetFirstSubset(subcsubset, 1);
repeat
ssptr := 0;
scptr := 0;
mptr := 0;
subsubset[k - 1] := k;
subcsubset[1] := v - k;

for i := 0 to k - 1 do
begin
if subset[subsubset[ssptr]] < csubset[subcsubset[scptr]] then
begin
mergeset[mptr] := subset[subsubset[ssptr]];
Inc(ssptr);
end
else
begin
mergeset[mptr] := csubset[subcsubset[scptr]];
Inc(scptr);
end;
Inc(mptr);
end;

subsubset[k - 1] := MAXV + 1;
subcsubset[1] := MAXV + 1;
mergeset[mptr] := MAXV + 1;
neighbors[nptr] := RankSubset(mergeset, k);
Inc(nptr);
until not GetNextSubset(subcsubset, 1, v - k);
until not GetNextSubset(subsubset, k - 1, k);
GetNextSubset(subset, k, v);
end;
end;

procedure CalculateOneCovering(kRank: Integer; var buf: TIntArray);
var
subset, csubset, subsubset, subcsubset, mergeset: TIntArray;
coverptr, ti, ssptr, scptr, mptr, i: Integer;
begin
SetLength(subset, MAXV + 1);
SetLength(csubset, MAXV + 1);
SetLength(subsubset, MAXV + 1);
SetLength(subcsubset, MAXV + 1);
SetLength(mergeset, MAXV + 1);

coverptr := 0;
UnrankSubset(kRank, subset, k);
subset[k] := MAXV + 1;
MakeComplement(subset, csubset, v);

for ti := t to MinVal(k, m) do
begin
GetFirstSubset(subsubset, ti);
repeat
GetFirstSubset(subcsubset, m - ti);
repeat
ssptr := 0;
scptr := 0;
mptr := 0;
subsubset[ti] := k;
subcsubset[m - ti] := v - k;

for i := 0 to m - 1 do
begin
if subset[subsubset[ssptr]] < csubset[subcsubset[scptr]] then
begin
mergeset[mptr] := subset[subsubset[ssptr]];
Inc(ssptr);
end
else
begin
mergeset[mptr] := csubset[subcsubset[scptr]];
Inc(scptr);
end;
Inc(mptr);
end;

subsubset[ti] := MAXV + 1;
subcsubset[m - ti] := MAXV + 1;
mergeset[mptr] := MAXV + 1;
buf[coverptr] := RankSubset(mergeset, m);
Inc(coverptr);
until not GetNextSubset(subcsubset, m - ti, v - k);
until not GetNextSubset(subsubset, ti, k);
end;
buf[coverptr] := BinCoef1(v, m);
end;

procedure CalculateCoverings;
var
r: Integer;
tempBuf: TIntArray;
begin
SetLength(tempBuf, coverLen);
for r := 0 to BinCoef1(v, k) - 1 do
begin
CalculateOneCovering(r, tempBuf);
Move(tempBuf[0], coverings[r * coverLen], coverLen * SizeOf(Integer));
end;
end;

procedure ComputeTables(tl, kl, ml, vl: Integer);
begin
t := tl;
k := kl;
m := ml;
v := vl;
AllocateMemory;
if onTheFly = 0 then
begin
CalculateNeighbors;
CalculateCoverings;
end;
end;

procedure CalculateCosts;
var
i: Integer;
begin
if pack <> 0 then
begin
for i := 0 to b do
begin
if i < coverNumber then
costs[i] := 0
else
costs[i] := i - coverNumber;
end;
end
else
begin
for i := 0 to b do
begin
if i < coverNumber then
costs[i] := coverNumber - i
else
costs[i] := 0;
end;
end;

for i := 0 to b - 1 do
costds[i] := costs[i] - costs[i + 1];
end;

function InitSolution: Integer;
var
initCost, i, j: Integer;
coveringsPtr: Integer;
begin
initCost := 0;

{ Initialize covered array }
for i := 0 to coveredLen - 1 do
covered[i] := 0;

for i := 0 to b - 1 do
begin
kset[i] := Random(BinCoef1(v, m));
if onTheFly <> 0 then
begin
SetLength(storedPtr[0], coverLen);
CalculateOneCovering(kset[i], storedPtr[0]);
coveringsPtr := 0;
end
else
coveringsPtr := kset[i] * coverLen;

for j := 0 to coverLen - 2 do
begin
if onTheFly <> 0 then
Inc(covered[storedPtr[0][j]])
else
Inc(covered[coverings[coveringsPtr + j]]);
end;
end;

for i := 0 to coveredLen - 1 do
initCost := initCost + costs[covered[i]];

Result := initCost;
end;

function RandomNeighbor(curr: Integer): Integer;
var
subset, csubset: TIntArray;
i, temp: Integer;
begin
SetLength(subset, MAXV + 1);
SetLength(csubset, MAXV + 1);

UnrankSubset(curr, subset, k);
MakeComplement(subset, csubset, v);
subset[Random(k)] := csubset[Random(v - k)];

{ Sort subset }
for i := 0 to k - 2 do
begin
if subset[i] > subset[i + 1] then
begin
temp := subset[i];
subset[i] := subset[i + 1];
subset[i + 1] := temp;
end;
end;

Result := RankSubset(subset, k);
end;

function ComputeNeighbor: Integer;
var
costDelta, currS: Integer;
currPtr, nextPtr: TIntArray;
i: Integer;
begin
costDelta := 0;

if restrictedNeighbors <> 0 then
begin
if setNumber + 1 = b then
setNumber := 0
else
setNumber := setNumber + 1;
end
else
setNumber := Random(b);

currS := kset[setNumber];

if onTheFly <> 0 then
nextS := RandomNeighbor(currS)
else
nextS := neighbors[currS * neighborLen + Random(neighborLen)];

if onTheFly <> 0 then
begin
{ Handle on-the-fly calculation }
SetLength(currPtr, coverLen);
SetLength(nextPtr, coverLen);
CalculateOneCovering(currS, currPtr);
CalculateOneCovering(nextS, nextPtr);
currSto := 0;
nextSto := 1;
end
else
begin
SetLength(currPtr, coverLen);
SetLength(nextPtr, coverLen);
Move(coverings[currS * coverLen], currPtr[0], coverLen * SizeOf(Integer));
Move(coverings[nextS * coverLen], nextPtr[0], coverLen * SizeOf(Integer));
end;

i := 0;
while i < (coverLen - 1) * 2 do
begin
if currPtr[0] = nextPtr[0] then
begin
{ Remove first elements }
Move(currPtr[1], currPtr[0], (Length(currPtr) - 1) * SizeOf(Integer));
Move(nextPtr[1], nextPtr[0], (Length(nextPtr) - 1) * SizeOf(Integer));
Inc(i);
end
else if currPtr[0] < nextPtr[0] then
begin
costDelta := costDelta + costds[covered[currPtr[0]] - 1];
Move(currPtr[1], currPtr[0], (Length(currPtr) - 1) * SizeOf(Integer));
end
else
begin
costDelta := costDelta - costds[covered[nextPtr[0]]];
Move(nextPtr[1], nextPtr[0], (Length(nextPtr) - 1) * SizeOf(Integer));
end;
Inc(i);
end;

Result := costDelta;
end;

procedure AcceptNeighbor;
var
currS, i: Integer;
coveringsPtr: Integer;
begin
currS := kset[setNumber];

if onTheFly <> 0 then
coveringsPtr := currSto * coverLen
else
coveringsPtr := currS * coverLen;

for i := 0 to coverLen - 2 do
begin
if onTheFly <> 0 then
Dec(covered[storedPtr[currSto][i]])
else
Dec(covered[coverings[coveringsPtr + i]]);
end;

if onTheFly <> 0 then
coveringsPtr := nextSto * coverLen
else
coveringsPtr := nextS * coverLen;

for i := 0 to coverLen - 2 do
begin
if onTheFly <> 0 then
Inc(covered[storedPtr[nextSto][i]])
else
Inc(covered[coverings[coveringsPtr + i]]);
end;

kset[setNumber] := nextS;
end;

function LocalOptimization(frozenVal, endLimitVal: Integer): Integer;
var
currCost, costDelta, notChanged: Integer;
begin
CalculateCosts;
currCost := InitSolution;
notChanged := 0;

while notChanged < frozenVal do
begin
costDelta := ComputeNeighbor;
Inc(iterCounter);

if costDelta < 0 then
begin
AcceptNeighbor;
notChanged := 0;
currCost := currCost + costDelta;
if currCost <= endLimitVal then
begin
Result := currCost;
Exit;
end;
end
else
Inc(notChanged);
end;

Result := currCost;
end;

function ApproxInitT: Double;
var
T: Double;
m2, i, costDelta: Integer;
begin
T := 0.0;
m2 := 0;

for i := 0 to 29 do
begin
costDelta := ComputeNeighbor;
if costDelta > 0 then
begin
Inc(m2);
T := T - costDelta;
end;
end;

if m2 <> 0 then
Result := T / m2 / Ln(initProb)
else
Result := 1.0;
end;

function SimulatedAnnealing(coolFactVal, initProbVal: Double; iterLength, frozenVal, endLimitVal: Integer): Integer;
var
currCost, bestSeen, notChanged: Integer;
T: Double;
m1, m2, m3, m0, i, costDelta: Integer;
r, D: Double;
begin
CalculateCosts;
currCost := InitSolution;
bestSeen := currCost;

if Tset <> 0 then
T := initialT
else
T := ApproxInitT;

notChanged := 0;
while notChanged < frozenVal do
begin
m1 := 0; m2 := 0; m3 := 0; m0 := 0;

for i := 0 to iterLength - 1 do
begin
costDelta := ComputeNeighbor;
Inc(iterCounter);

if costDelta <= 0 then
begin
Inc(m3);
AcceptNeighbor;
currCost := currCost + costDelta;

if currCost <= endLimitVal then
begin
endT := T;
Result := currCost;
Exit;
end;

if costDelta < 0 then
begin
notChanged := 0;
if currCost < bestSeen then
bestSeen := currCost;
end
else
Inc(m0);
end
else
begin
r := Random01;
D := costDelta / T;
if r < ExpProb(D) then
begin
AcceptNeighbor;
Inc(m1);
currCost := currCost + costDelta;
end
else
Inc(m2);
end;
end;

if currCost <= bestSeen then
Inc(notChanged);

T := T * coolFactVal;
end;

endT := T;
Result := currCost;
end;

procedure SortSolution;
var
i, j, temp: Integer;
begin
{ Simple bubble sort }
for i := 0 to b - 2 do
for j := 0 to b - 2 - i do
if kset[j] > kset[j + 1] then
begin
temp := kset[j];
kset[j] := kset[j + 1];
kset[j + 1] := temp;
end;
end;

procedure PrintSubset(r, card: Integer);
var
subset: TIntArray;
i: Integer;
begin
SetLength(subset, MAXV + 1);
UnrankSubset(r, subset, card);

if solX <> 0 then
begin
{ Handle solX logic }
end;

for i := 0 to card - 1 do
Write(Format('%2d ', [subset[i] + 1]));
WriteLn;
end;

procedure PrintSolution;
var
j: Integer;
begin
for j := 0 to b - 1 do
PrintSubset(kset[j], k);
end;

function CommonElements(mRank, kRank: Integer): Integer;
var
mSet, kSet: TIntArray;
mPtr, kPtr, matchCount, i: Integer;
begin
SetLength(mSet, MAXV + 1);
SetLength(kSet, MAXV + 1);

UnrankSubset(mRank, mSet, m);
UnrankSubset(kRank, kSet, k);
mSet[m] := MAXV;
kSet[k] := MAXV;

mPtr := 0;
kPtr := 0;
matchCount := 0;

for i := 0 to k + m - 1 do
begin
if mSet[mPtr] = kSet[kPtr] then
begin
Inc(matchCount);
Inc(mPtr);
Inc(kPtr);
end
else if mSet[mPtr] > kSet[kPtr] then
Inc(kPtr)
else
Inc(mPtr);
end;

Result := matchCount;
end;

function CheckSolution: Integer;
var
totalCost, mRank, found, i: Integer;
begin
totalCost := 0;

for mRank := 0 to BinCoef1(v, m) - 1 do
begin
found := 0;
for i := 0 to b - 1 do
begin
if CommonElements(mRank, kset[i]) >= t then
Inc(found);
end;
totalCost := totalCost + costs[found];

if (verbose >= 2) and (costs[found] <> 0) then
PrintSubset(mRank, m);
end;

Result := totalCost;
end;

function NewSplitB(bVal, hi, lo, found: Integer): Boolean;
begin
if hi - lo <= 1 then
begin
Result := False;
Exit;
end;

BIs(lo + (hi - lo + 1) div 2);
Result := True;
end;

function SearchBContinues(found: Integer; var hiB, loB: Integer): Boolean;
begin
if searchB = 0 then
begin
Result := False;
Exit;
end;

if loB = -1 then
begin
if found <> 0 then
begin
hiB := b;
BIs(NewBAfterSuccess(b));
Result := True;
end
else
begin
loB := b;
Result := NewSplitB(b, hiB, loB, found);
end;
end
else
begin
if found <> 0 then
hiB := b
else
loB := b;
Result := NewSplitB(b, hiB, loB, found);
end;
end;

procedure FreeTables;
begin
if onTheFly = 0 then
SetLength(neighbors, 0);
SetLength(coverings, 0);
SetLength(covered, 0);
if Length(kset) > 0 then
SetLength(kset, 0);
end;

procedure InitializeGlobals;
begin
{ Initialize global variables }
neighborLen := 0;
coverLen := 0;
coveredLen := 0;
iterCounter := 0;
endT := 0.0;

{ Initialize parameters }
coolFact := 0.99;
initProb := 0.5;
v := 12;
k := 6;
t := 5;
m := 5;
b := 10;
testCount := 1;
restrictedNeighbors := 0;
initialT := 1.0;
frozen := 10;
endLimit := 0;
apprexp := 0;
Tset := 0;
L := 24;
Lset := 0;
LFact := 1.0;
localOpt := 0;
onTheFly := 0;
coverNumber := 1;
solX := 0;
memoryLimit := 0;
searchB := 0;
SBFact := 0.95;
pack := 0;
check := 0;
verbose := 2;
setNumber := 0;
nextS := 0;
// stored[0] := 0;
// stored[1] := 0;
currSto := 0;
nextSto := 0;
end;

{ Main program }
var
costSum, finalCost, bestCost: Integer;
hiB, loB: Integer;
count1: Integer;

begin
Randomize;
InitializeGlobals;

// retVal := 0;
costSum := 0;
finalCost := 0;
bestCost := -1;
hiB := -1;
loB := -1;

if verbose <> 0 then
begin
{ Handle verbose output }
WriteLn('Starting optimization...');
end;

{ Initialize binomial coefficients }
// for retVal := 0 to MAXV do
// for costSum := 0 to MAXV + 1 do
// binCoef[retVal, costSum] := BinCoef1(retVal, costSum);

CalculateExps;

if Lset = 0 then
L := Round(LFact * k * (v - k) * b + 0.5);

if searchB <> 0 then
BIs(NewBAfterSuccess(hiB))
else
BIs(b);

ComputeTables(t, k, m, v);

repeat
for count1 := 0 to testCount - 1 do
begin
iterCounter := 0;
if localOpt <> 0 then
finalCost := LocalOptimization(L, endLimit)
else
finalCost := SimulatedAnnealing(coolFact, initProb, L, frozen, endLimit);

// if finalCost <= endLimit then
// count1 := testCount;

if (bestCost = -1) or (finalCost < bestCost) then
bestCost := finalCost;

costSum := costSum + finalCost;

// if verbose <> 0 and (finalCost <= endLimit) then
begin
WriteLn('Solution found with cost: ', finalCost);
PrintSolution;
end;

if (check <> 0) and (CheckSolution <> finalCost) then
begin
WriteLn('Error: Check failed');
end;
end;
until not SearchBContinues(Ord(finalCost <= endLimit), hiB, loB);

WriteLn('Best cost found: ', bestCost);
WriteLn('Total iterations: ', iterCounter);

FreeTables;
end.
2025-08-03 (23:02)

status vidmo
Data rejestracji: 2004-11-03
Ilość postów: 12804

449
wpis nr 1 574 493
[ CZCIONKA MONOSPACE ]

Witaj ponownie Leo.
Może uda Ci się osiągnąć 100% w tej pozycji:
C(70,28,8x 8,20)=8 - 99,24155%
Powidoki od videmka.
2025-08-04 (14:04)

status 777ch
Data rejestracji: 2005-11-07
Ilość postów: 22780

1386
wpis nr 1 574 545
[ CZCIONKA MONOSPACE ]

BochiCintra

Cześć,
nikt się "tym" tu nie interesuje,
..raczej nikt.

Ja również nie mam na to ochoty .

Ale .....dziekuję Ci
za wpis ,
i
za kawał kodu .
2025-08-04 (23:58)

status BochiCintra
Data rejestracji: 2019-07-29
Ilość postów: 103

16005
wpis nr 1 574 610
[ CZCIONKA MONOSPACE ]

ok
2025-08-05 (17:45)

status heme24
Data rejestracji: 2015-12-08
Ilość postów: 344

14639
wpis nr 1 574 685
[ CZCIONKA MONOSPACE ]

Witam.

777ch kurcze już tyle lat piszesz tu na forum, jesteś chyba rekordzistą, tyle osób które kiedyś tu pisało
już znikły, pisz dalej bo masz ciekawy punkt widzenia na tematy lotto.

Pozdrawiam
2025-08-05 (18:03)

status 777ch
Data rejestracji: 2005-11-07
Ilość postów: 22780

1386
wpis nr 1 574 688
[ CZCIONKA MONOSPACE ]

heme24

Lepiej nic nie pisać,
niż ..pisać głupoty.

Kwestia druga ..
to po co i do kogo
skierowany jest wpis.

No i ..
wobec tego .. zamilkłem. 🤐
2025-08-05 (18:30)

status heme24
Data rejestracji: 2015-12-08
Ilość postów: 344

14639
wpis nr 1 574 690
[ CZCIONKA MONOSPACE ]

Witam.

777ch nie zamilkaj...
2025-09-11 (10:22)

status 777ch
Data rejestracji: 2005-11-07
Ilość postów: 22780

1386
wpis nr 1 579 322
[ CZCIONKA MONOSPACE ]

Od czasu do czasu coś napiszę.

Mini lotto ,
gra w której losowane jest aktualnie 5 liczb z 42.
Wszystkich 5-ek z 42 liczb jest 850 668.

A jednak ..... przy zawartych ponad 1,2 mln zakładów
np:

nie pada zadna 5-ka

No i TERAZ.
gdyby ktoś z Was pokusił się o wylosowanie
tych 1,2 mln piątek to zobaczy jak to losowe rozdanie
w rzeczywistości pokrywa cały zbiór [850 668].

Jeśli generator losowo zestawi 1 200 000 zakładów
to przekonacie się że pokrycie całego zbioru [850 668]
będzie wynosiło zawsze cirka 73 %
i zawsze niepokrytych 5-ek będzie
cirka tyle samo.

Przykład 4-losowo wygenerowanych zbiorów 1,2 mln 5z42

-----------------------------------
liczba powtórek csn : 572514
ilość linii sprawdzanych : 1200000
Unique5 : 627486
wszystkich csn : 1200000

Elapsed time 00:00:00:124
Coverage[5] % 73,7639125957483%
Uncovered[5] 223182
-----------------------------------
liczba powtórek csn : 571892
ilość linii sprawdzanych : 1200000
Unique5 : 628108
wszystkich csn : 1200000

Elapsed time 00:00:00:109
Coverage[5] % 73,8370316033987%
Uncovered[5] 222560
-----------------------------------
liczba powtórek csn : 572312
ilość linii sprawdzanych : 1200000
Unique5 : 627688
wszystkich csn : 1200000

Elapsed time 00:00:00:141
Coverage[5] % 73,7876586400335%
Uncovered[5] 222980
-----------------------------------


Czyli niepokrytych
jest --> cirka tyle samo [220 000] piątek,
,a powtórnie wylosowanych
co najmniej 2*
jest również --> cirka tyle samo [570 000] piątek.

Unikatowych zakładów
jest zwykle [627 000]


No...... czy to nie ciekawe

Bo w chaosie rodzi się porządek .


»Porządek w chaosie
https://www.miloszwojciechowski.pl/do-poczytania/inne/porzadek-w-chaosie/




2025-09-11 (12:56)

status 777ch
Data rejestracji: 2005-11-07
Ilość postów: 22780

1386
wpis nr 1 579 339
[ CZCIONKA MONOSPACE ]

No i TERAZ.
gdyby ktoś z Was pokusił się o wylosowanie
tych 1,2 mln piątek to zobaczy
--> jak
[? tu dodaję po jak pytajnik]
to losowe rozdanie
w rzeczywistości pokrywa cały zbiór [850 668].

no i zawsze będzie to cirka 73% z [850 668].


ale.............

Marriusz2 riposuje
Tyle ,że one nie są losowane .

I to jest fakt .....
"czynnik ludzki" ...... nie wdając się w szczegóły
zaniży poziom 73% ...

jak bardzo nie mam pojęcia
ale na pewno ...... dość sporo.
Przykłady są znane z historii...... gier

cyt: źródło:
https://www.rmf24.pl/fakty/polska/news-30-lat-temu-osiemdziesiat-osob-trafilo-szostke-w-lotto,nId,7420442


cyt:
..."Typowanie szczęśliwych liczb
Ludzie najczęściej grają na "chybił trafił" - przyznała Aida Bella. Rzeczniczka Totalizatora dodała, że wraca tradycja prowadzenia zeszytów z ulubionymi liczbami.

W dawnych czasach były popularne zeszyty, w których gracze zapisywali swoje liczby i historię gier.

Nasi klienci opowiadają, że odszukali zeszyt swojego dziadka i kontynuują tradycję. Podobne zapiski prowadziły raczej osoby starsze - opowiadała Bella. ....."



cyt:źródło:
https://www.fakt.pl/wydarzenia/polska/az-80-szostek-w-lotto-jednego-dnia-czarny-dzien-polskich-milionerow/ts7xyre

."I zdarza się cud! Wygrywasz szóstkę w totka. Tak samo, jak 80 innych osób. Tak właśnie zdarzyło się 30 marca 1994 roku. Ze względu na datę wiele osób myślało, że ma do czynienia z żartem na Prima Aprilis. A jednak była to prawda. Zwycięskie liczby to 11, 16, 23, 30, 35, 41.

Skąd wszyscy je znali? Pochodziły z obrazka umieszczonego na ówcześnie stosowanym blankiecie do typowania....."



Tak więc ........ "CZYNNIK LUDZKI" ... spowoduje
że 1,2 mln zakładów nie osiągnie ......
przewidywanych generatorem
poziomów % rozkładów losowych,

--> słuszna uwaga.

| Dodaj wpis w tym temacie | Spis tematów | Wyniki lottoStrona: 1 2 ... 555 556 557 558 559 560 561
Wyślij wiadomość do admina