Jump to content
Janilabo

RandomRangeEx (TIARandomRange)

By Janilabo, in Other Snippets

Recommended Posts

Janilabo Contributing Member

 Janilabo

Posted
Posted (edited) 
function RandomRangeEx(aFrom, aTo, amount: Integer; duplicates: Boolean): TIntArray;
var
 a, d, e, m, n, r, i, t: Integer;
 tmp: TIntArray;
 b: Boolean;
begin
 if (amount > 0) then
 case duplicates of
   False:
   begin
     if (aFrom > aTo) then
       Swap(aFrom, aTo);     
     a := IAbs(aTo - aFrom);
     if (a < amount) then
       amount := a; 
     if (amount < 1) then
       Result := [aFrom]
     else
       case (amount < 20000) of
         True:
         for r := 0 to (amount - 1) do
           repeat  
             n := RandomRange(aFrom, aTo);
             if not TIAContains(Result, n) then
               i := TIAAppend(Result, n);
           until (i >= r);
         False:
         begin     
           SetLength(Result, amount);
           m := IAbs(aFrom - aTo); 
           if (m > 10) then
             b := (m > Trunc(amount * 1.1));
           case b of
             True:
             begin          
               d := (Trunc(m / amount) + 3); 
               e := aFrom;
               for i := 0 to (amount - 1) do
               begin                            
                 r := Random(d);         
                 IncEx(e, r);      
                 IncEx(t, (r + 1));
                 Result[i] := (e + i); 
                 Swap(Result[Random(i)], Result[Random(i)]);         
                 d := (Trunc(((m - t) / (amount - i))) * 2); 
               end;
               for i := 0 to (amount div 2) do
                 Swap(Result[Random(amount)], Result[Random(amount)]);
             end;
             False: 
             begin     
               SetLength(tmp, (aTo - aFrom));
               for i := aFrom to (aTo - 1) do
                 tmp[(i - aFrom)] := i;      
               for i := 0 to (amount - 1) do
               begin   
                 r := Random((aTo - aFrom) - i);  
                 Result[i] := tmp[r];   
                 Delete(tmp, r, 1);
               end;
               SetLength(tmp, 0);
             end;
           end;                        
         end;                     
       end;   
   end;
   True:   
   begin 
     SetLength(Result, amount);
     for i := 0 to (amount - 1) do
       Result[i] := RandomRange(aFrom, aTo);
   end;
 end;
end;

var
 i: Integer;

begin
 ClearDebug;
 for i := 1 to 10 do
   WriteLn(TIAToStr(RandomRangeEx(0, i, 5, False)));
end.

Edited by Janilabo
Link to comment
Share on other sites
FHannes God Member

 FHannes

Posted
Posted (edited)

Hmm, nice work. Try this:

[scar]function RandomRangeEx3(aFrom, aTo, amount: Integer; duplicates: Boolean): TIntArray;

var

r, i: Integer;

begin

if (amount > 0) then

begin

SetLength(Result, amount);

for i := 0 to (amount - 1) do

Result := RandomRange(aFrom, aTo);

if not duplicates then

TIAUnique(Result);

end;

end;[/scar]

Normally this approach should give you less performance than your RandomRangeEx2, as it has it's much more efficient to check is something is already in the array before adding it then removing the duplicates afterwards. However, in this case you can see it outperforms RandomRangeEx2 easily. The obvious reason for this is that code in SCAR scripts runs slower than native code, so by moving more of the work into SCAR's API, you speed up the script.

 

RandomRangeEx: 1685 ms.
RandomRangeEx2: 15 ms.
RandomRangeEx3: 0 ms.

 

This difference obviously doesn't matter, but once you get to larger sets of numbers, it does. For example, with 100000 numbers:

RandomRangeEx2: 3073 ms.
RandomRangeEx3: 1482 ms.

Edited by Freddy
Link to comment
Share on other sites
Janilabo Contributing Member

 Janilabo

Posted
  • Author
Posted

Nice work Freddy, but it's not doing exactly the same thing.

 

You see:

 

function RandomRangeEx2(aFrom, aTo, amount: Integer; duplicates: Boolean): TIntArray;
var
 a, r, i, n: Integer;
begin
 if (amount > 0) then
 case duplicates of
   True:   
   begin 
     SetLength(Result, amount);
     for i := 0 to (amount - 1) do
       Result[i] := RandomRange(aFrom, aTo);
   end;
   False:
   begin
     if (aFrom > aTo) then
       Swap(aFrom, aTo);     
     a := IAbs(aTo - aFrom);
     if (a < amount) then
       amount := a; 
     if (amount < 1) then
       Result := [0]
     else
       for r := 0 to (amount - 1) do
         repeat  
           n := RandomRange(aFrom, aTo);
           if not TIAContains(Result, n) then
             i := TIAAppend(Result, n);
         until (i >= r);    
   end;
 end;
end;

function RandomRangeEx3(aFrom, aTo, amount: Integer; duplicates: Boolean): TIntArray;
var
 r, i: Integer;
begin
 if (amount > 0) then
 begin
   SetLength(Result, amount);
   for i := 0 to (amount - 1) do
     Result[i] := RandomRange(aFrom, aTo);  
   if not duplicates then
     TIAUnique(Result);
 end;
end;

var
 TIA: TIntArray;

begin
 ClearDebug;
 TIA := RandomRangeEx3(1, 21, 20, False);
 WriteLn(TIAToStr(TIA) + ' [' + IntToStr(Length(TIA)) + ' items]');
 SetLength(TIA, 0);   
 TIA := RandomRangeEx2(1, 21, 20, False);
 WriteLn(TIAToStr(TIA) + ' [' + IntToStr(Length(TIA)) + ' items]');
 SetLength(TIA, 0);
end.

Link to comment
Share on other sites
FHannes God Member

 FHannes

Posted
Posted (edited)

Woops my bad :P

 

EDIT: How about this?

 

[scar]function RandomRangeEx2(aFrom, aTo, Size: Integer; duplicates: Boolean): TIntArray;

var

I, Val, Tmp, HashVal, NULL: Integer;

HashTable: TIntArray;

begin

if (Size > 0) then

case duplicates of

True: begin

SetLength(Result, Size);

for I := 0 to Size - 1 do

Result := RandomRange(aFrom, aTo);

end;

False: begin

if (aFrom > aTo) then

Swap(aFrom, aTo);

NULL := aFrom - 1;

Tmp := IAbs(aTo - aFrom);

if Tmp < Size then

Size := Tmp;

if Size < 1 then

begin

Result := [0];

Exit;

end;

SetLength(HashTable, Size);

for I := 0 to Size - 1 do

HashTable := NULL;

SetLength(Result, Size);

I := 0;

while I <> Size do

begin

Val := RandomRange(aFrom, aTo);

HashVal := (Val - aFrom) mod Size;

while (HashTable[HashVal] <> NULL) and (HashTable[HashVal] <> Val) do

HashVal := (HashVal + 1) mod Size;

if HashTable[HashVal] = NULL then

begin

Result := Val;

HashTable[HashVal] := Val;

Inc(I);

end;

end;

end;

end;

end;[/scar]

 

It's a lot slower than your RandomRangeEx2, as it's coded entirely in SCAR, but it's an improvement on RandomRangeEx, and faster than RandomRangeEx2 if it were native code probably. It uses hashing with linear probing to determine if you already have a value. This means that the check is performed in near constant time. This removed the need to loop through your results to check if the result is already there.

 

For your testcase:

RandomRangeEx: 1669 ms.
RandomRangeEx2: 140 ms.

 

As the number of requested values increases, this function won't get quite as slow, as the lookup time remains the same basically.

 

To give you an idea:

RandomRangeEx2(-99999, 99999, 10000, False);
=>
RandomRangeEx2: 2823 ms.

 

Do note that the hashing in this RandomRangeEx2 function isn't all that impressive as it just uses mod to map the value onto the hashtable basically, a better hash with fewer collisions could improve the performance even more, but this was sufficient for demonstrating purposes.

Edited by Freddy
Link to comment
Share on other sites
Janilabo Contributing Member

 Janilabo

Posted
  • Author
Posted (edited)

Holy crap! Freddy, that's like rocket science to me... :D

Amazing job! Great piece of code and it clearly shows I still have a LOT of stuff to learn..

 

Below is my newest function that I am working on, which seems to perform pretty quickly too..

 

function RandomRangeEx2(aFrom, aTo, amount: Integer; duplicates: Boolean): TIntArray;
var
 a, r, i, n: Integer;
begin
 if (amount > 0) then
 case duplicates of
   True:   
   begin 
     SetLength(Result, amount);
     for i := 0 to (amount - 1) do
       Result[i] := RandomRange(aFrom, aTo);
   end;
   False:
   begin
     if (aFrom > aTo) then
       Swap(aFrom, aTo);     
     a := IAbs(aTo - aFrom);
     if (a < amount) then
       amount := a; 
     if (amount < 1) then
       Result := [0]
     else
       for r := 0 to (amount - 1) do
         repeat  
           n := RandomRange(aFrom, aTo);
           if not TIAContains(Result, n) then
             i := TIAAppend(Result, n);
         until (i >= r);    
   end;
 end;
end;

function RandomRangeEx4(aFrom, aTo, amount: Integer; duplicates: Boolean): TIntArray;
var
 a, r, i, n: Integer;
 tmp: TIntArray;
begin
 if (amount > 0) then
 case duplicates of
   True:   
   begin 
     SetLength(Result, amount);
     for i := 0 to (amount - 1) do
       Result[i] := RandomRange(aFrom, aTo);
   end;
   False:
   begin
     if (aFrom > aTo) then
       Swap(aFrom, aTo);     
     a := IAbs(aTo - aFrom);
     if (a < amount) then
       amount := a; 
     if (amount < 1) then
     begin
       Result := [aFrom];
       Exit;
     end;                          
     SetLength(tmp, (aTo - aFrom));
     for i := aFrom to (aTo - 1) do
       tmp[(i - aFrom)] := i;      
     SetLength(Result, amount);
     for i := 0 to (amount - 1) do
     begin   
       r := Random((amount - 1) - i);
       Result[i] := tmp[r];   
       Delete(tmp, r, 1);
     end;    
   end;
 end;
end;

var
 tm: Integer;
 TIA: TIntArray;

begin
 ClearDebug;   
 tm := GetSystemTime;
 TIA := RandomRangeEx2(-9999, 9999, 20000, False);
 WriteLn('RandomRangeEx2: ' + IntToStr(Length(TIA)) + ' items!' + ' [' + IntToStr(GetSystemTime - tm) + ' ms.]');
 SetLength(TIA, 0);   
 tm := GetSystemTime;
 TIA := RandomRangeEx4(-9999, 9999, 20000, False);
 WriteLn('RandomRangeEx4: ' + IntToStr(Length(TIA)) + ' items!' + ' [' + IntToStr(GetSystemTime - tm) + ' ms.]');
 SetLength(TIA, 0);   
end.

 

I just need to add some randomized skipping to it, so it will be a little better than right now..

Edited by Janilabo
Link to comment
Share on other sites
Janilabo Contributing Member

 Janilabo

Posted
  • Author
Posted

Thanks Freddy (powered by SCAR Divi 3.38 <3):

 

const
 RANGE_FROM = 0;
 RANGE_TO = 100000;
 AMOUNT = 100000; 

function RandomRangeEx_OLD(aFrom, aTo, amount: Integer; duplicates: Boolean): TIntArray;
var
 a, d, e, m, n, r, i, t: Integer;
 tmp: TIntArray;
 b: Boolean;
begin
 if (amount > 0) then
 case duplicates of
   False:
   begin
     if (aFrom > aTo) then
       Swap(aFrom, aTo);     
     a := IAbs(aTo - aFrom);
     if (a < amount) then
       amount := a; 
     if (amount < 1) then
       Result := [aFrom]
     else
       case (amount < 20000) of
         True:
         for r := 0 to (amount - 1) do
           repeat  
             n := RandomRange(aFrom, aTo);
             if not TIAContains(Result, n) then
               i := TIAAppend(Result, n);
           until (i >= r);
         False:
         begin     
           SetLength(Result, amount);
           m := IAbs(aFrom - aTo); 
           if (m > 10) then
             b := (m > Trunc(amount * 1.1));
           case b of
             True:
             begin          
               d := (Trunc(m / amount) + 3); 
               e := aFrom;
               for i := 0 to (amount - 1) do
               begin                            
                 r := Random(d);         
                 IncEx(e, r);      
                 IncEx(t, (r + 1));
                 Result[i] := (e + i); 
                 Swap(Result[Random(i)], Result[Random(i)]);         
                 d := (Trunc(((m - t) / (amount - i))) * 2); 
               end;
               for i := 0 to (amount div 2) do
                 Swap(Result[Random(amount)], Result[Random(amount)]);
             end;
             False: 
             begin     
               SetLength(tmp, (aTo - aFrom));
               for i := aFrom to (aTo - 1) do
                 tmp[(i - aFrom)] := i;      
               for i := 0 to (amount - 1) do
               begin   
                 r := Random((aTo - aFrom) - i);  
                 Result[i] := tmp[r];   
                 Delete(tmp, r, 1);
               end;
               SetLength(tmp, 0);
             end;
           end;                        
         end;                     
       end;   
   end;
   True:   
   begin 
     SetLength(Result, amount);
     for i := 0 to (amount - 1) do
       Result[i] := RandomRange(aFrom, aTo);
   end;
 end;
end;

function RandomRangeEx_NEW(aFrom, aTo, amount: Integer; duplicates: Boolean): TIntArray;
begin
 Result := RandomTIAEx(amount, (aTo - aFrom), duplicates);
 OffsetTIA(Result, aFrom);
end;

var
 TIA: TIntArray;
 t: Integer;

begin
 ClearDebug;
 t := GetSystemTime;
 TIA := RandomRangeEx_OLD(RANGE_FROM, RANGE_TO, AMOUNT, False);
 WriteLn('OLD: ' + IntToStr(GetSystemTime - t) + ' ms.');
 SetLength(TIA, 0);         
 t := GetSystemTime;
 TIA := RandomRangeEx_NEW(RANGE_FROM, RANGE_TO, AMOUNT, False);
 WriteLn('NEW: ' + IntToStr(GetSystemTime - t) + ' ms.');
 SetLength(TIA, 0); 
end.

 

Timing:

 

OLD: 4696 ms.
NEW: 15 ms.
Successfully executed (4718.6118 ms)

Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

Guest
Reply to this topic...

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
Go to topic listing
×
×
  • Create New...