Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations derfloh on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

random logic eludes me 3

Status
Not open for further replies.

lespaul

Programmer
Feb 4, 2002
7,083
US
So I am trying to help a friend out with an assignment application. There are 12 hunters in this group. There are 4 blinds that they can use...2 hunters per blind per day. I have this code that does what needs to be done, but I don't like the fact that the pairings never change:
Code:
procedure TForm_Main.Btn_StartClick(Sender: TObject);
var
  J, i, h: integer;
  dtStart, dtEnd: TDateTime;
  slTemp: TStringList;
  AvailDays: set of 1..7;
begin
  AvailDays:= [];

  if CheckBox1.Checked
  then Include(AvailDays, 1);

  if CheckBox2.Checked
  then Include(AvailDays, 2);

  if CheckBox3.Checked
  then Include(AvailDays, 3);

  if CheckBox4.Checked
  then Include(AvailDays, 4);

  if CheckBox5.Checked
  then Include(AvailDays, 5);

  if CheckBox6.Checked
  then Include(AvailDays, 6);

  if CheckBox7.Checked
  then Include(AvailDays, 7);

  slTemp:= TStringList.Create;
  Memo1.Clear;
  dtStart:= dtPickerStart.Date;
  dtEnd:= dtPickerEnd.Date;
  h := 0;
  J:= Trunc(dtStart);

  while J <= Trunc(dtEnd) do
  begin
    if DayOfTheWeek(J) in AvailDays
    then
      begin
        slTemp:= GetHunters;
        for i := 1 to 4 do
        begin
          if i = 1 then
          begin
            Memo1.Lines.Add(FormatDateTime('mm/dd/yy  ddd', J));
            Memo1.Lines.Add(EmptyStr);
          end;
          memo1.lines.add(Format('  %2s Blind ' + IntToStr(i), [slTemp[h]]));
          inc(h);
          if h > slTemp.Count - 1 then h := 0;
          memo1.lines.add(Format('  %2s Blind ' + IntToStr(i), [slTemp[h]]));
          inc(h);
          Memo1.Lines.Add(EmptyStr);
          if h > slTemp.Count - 1 then h := 0;
        end;
      end;
     Inc(J);
  end;

  slTemp.Free;
end;

it produces this:
[tt]08/20/08 Wed

6 Blind 1
2 Blind 1

1 Blind 2
7 Blind 2

4 Blind 3
12 Blind 3

10 Blind 4
9 Blind 4

08/21/08 Thu

3 Blind 1
11 Blind 1

5 Blind 2
8 Blind 2

6 Blind 3
2 Blind 3

1 Blind 4
7 Blind 4

08/23/08 Sat

4 Blind 1
12 Blind 1

10 Blind 2
9 Blind 2

3 Blind 3
11 Blind 3

5 Blind 4
8 Blind 4[/tt]

What I would like for it to do is random select two hunters for each blind each day, but I can't quite get my head around the logic....
any suggestions appreciated!

leslie
 
show the whole project,

I think we need to inspect the logic in the GetHunters() function.

/Daddy

-----------------------------------------------------
What You See Is What You Get
Never underestimate tha powah of tha google!
 
it creates a TStringList:

Code:
function TForm_Main.GetHunters: TStringList;
var
  sTemp: string;
  slHunters: TStringList;
begin
  slHunters:= TStringList.Create;
  Randomize;

  while slHunters.Count < 12 do  //number of hunters in group
  begin
    sTemp:= IntToStr(RandomRange(1, 13)); // from 1 to number of hunters + 1

    if slHunters.IndexOf(sTemp) = -1
    then slHunters.Add(sTemp);

  end;

  Result:= slHunters;
  //slHunters.Free;
end;

Thanks!
Les
 
Your logic that has been shown is good. The problem you are running into, however, is that RandomRange involves a pseudo-random number generator. The word "pseudo" is in there, since it fakes randomness.

The issue you are having is that for such a small sample, you aren't getting enough randomness. How to solve it? You need to have requirements defined with whoever wants this program that indicate the degree of randomness required. For a business language definition, you would have to ask "After how many days is it acceptable to pair two hunters up again?", and then go from there to the logic.

For the technical issue, much depends on answering that question. But the approach would have to be taken to store previous pairings and not repeat them within the agreed amount of time. There's two or three ways I can think of to do that, but the method choice is going to depend on what kind of resources you are willing to use.

Hopefully that helps some, and feel free to ask if you need any help with getting the logic itself written out.

----------
Measurement is not management.
 
It actually hasn't been asked for at all, it just bothers me that each person is always paired with the same person! I would say that as long as it isn't identical every rotation (which is every 1 1/2 days - every 12 assignments) that would be ok. What would be the easiest way to do that?

Leslie
 
I think your problem is misuse of Randomize. The reason you keep repeating the same list of numbers is that you re-seed the PRNG every time you retrieve a list. You should only seed the PRNG once in a program, which is easily done in the initialization section. From then on, calls to random functions should produce pseudo-random values.
 
agree totally with harebrain!

/Daddy

(oh and a star for the correct solution offcourse)

-----------------------------------------------------
What You See Is What You Get
Never underestimate tha powah of tha google!
 
I think your problem is misuse of Randomize. The reason you keep repeating the same list of numbers is that you re-seed the PRNG every time you retrieve a list.

Incorrect solution.

Randomize places a random seed value into the PRNG via the system time and other factors. Which means I can call it 1 or 10,000 times and still have a reasonably repeating set of numbers, as long as I do not call it every time. The only way that a repeating & consistent list of numbers will be produced is if the random seed value is directly assigned. If I were to call randomize every time, a single number would be produced, and this is not what the OP is seeing.

Code:
procedure TForm1.Button1Click(Sender: TObject);
var
  i: integer;
begin
  Randseed := 10;
  Memo1.Clear;
  for i := 1 to 10 do
    Memo1.Lines.Add(IntToStr(Random(100000) + 1));
end;

You can hammer the button on the form all day and it will produce the same values. Contrast with this, which mirrors what the OP is doing.

Code:
procedure TForm1.Button2Click(Sender: TObject);
var
  i: integer;
begin
  randomize;
  Memo1.Clear;
  for i := 1 to 10 do
    Memo1.Lines.Add(IntToStr(Random(100000) + 1));
end;

Each time this button is pressed, randomize will be called, but will not produce a consistent repeatable string of numbers. The numbers are still random enough.

While I agree that it is suitable that Randomize be called as part of an initialization routine in this program, calling it within the function IS NOT the problem that the OP is seeing.

The problem is that the sample size is too small and repeating numbers occur too frequently to simply use the PRNG.

----------
Measurement is not management.
 
Ok, not sure what we've decided about what I've already done...how would you approach this issue?

I need to take a range of dates:
8/20/2008 - 8/31/2008
and randomly assign 12 hunters to the blinds and then repeat:
[tt]
8/20/2008
blind 1 person 1
blind 1 person 2

blind 2 person 3
blind 2 person 4

blind 3 person 5
blind 3 person 6

blind 4 person 7
blind 4 person 8

8/21/2008
blind 1 person 9
blind 1 person 10

blind 2 person 11
blind 2 person 12
************************all hunters used start over
blind 3 person 1
blind 3 person 2

blind 4 person 3
blind 4 person 4

8/22/2008
blind 1 person 5
blind 1 person 6

blind 2 person 7
blind 2 person 8

blind 3 person 9
blind 3 person 10

blind 4 person 11
blind 4 person 12
************************all hunters used start over[/tt]
so the above is basically what I end up with now. The same pattern of people.
I would like it to be more random:
[tt]
8/20/2008
blind 1 person 10
blind 1 person 3

blind 2 person 6
blind 2 person 1

blind 3 person 2
blind 3 person 9

blind 4 person 8
blind 4 person 4

8/21/2008
blind 1 person 5
blind 1 person 12

blind 2 person 11
blind 2 person 7
************************all hunters used start over
blind 3 person 2
blind 3 person 4

blind 4 person 8
blind 4 person 12

8/22/2008
blind 1 person 6
blind 1 person 11

blind 2 person 10
blind 2 person 9

blind 3 person 1
blind 3 person 7

blind 4 person 3
blind 4 person 5
************************all hunters used start over[/tt]

What would be the easiest way to accomplish the second scenario?

I tried putting the randomize in the initialization but it used people more than once within a single rotation.


Leslie

Have you met Hardy Heron?
 
I don't see a problem with the random order logic, I see a problem with WHEN it's called:

It's being called for every hunt DAY. It should only be called after each person has had an opportunity to hunt. I haven't actually worked that out yet, but here is my results of the current code as is:
Code:
---Hunter order is 6, 8, 9, 1, 3, 11, 10, 4, 12, 7, 5, 2, ---
08/20/08  Wed

Blind: 1  Person: 6  (All 1st hunt)
Blind: 1  Person: 8

Blind: 2  Person: 9
Blind: 2  Person: 1

Blind: 3  Person: 3
Blind: 3  Person:11

Blind: 4  Person:10
Blind: 4  Person: 4   (Person 12, 7, 5, 2 didn't hunt)

---Hunter order is 4, 10, 11, 12, 6, 2, 3, 1, 9, 5, 8, 7, ---
08/21/08  Thu

Blind: 1  Person: 9    (2nd)
Blind: 1  Person: 5     1

Blind: 2  Person: 8    (2nd)
Blind: 2  Person: 7     1
          --------- starts over
Blind: 3  Person: 4    (2nd)
Blind: 3  Person:10    (2nd)

Blind: 4  Person:11    (2nd)
Blind: 4  Person:12    1    (Person 2 STILL didn't hunt)

---Hunter order is 5, 12, 2, 7, 9, 8, 11, 1, 4, 3, 10, 6, ---
08/22/08  Fri

Blind: 1  Person: 9    (3rd)
Blind: 1  Person: 8    (3rd)

Blind: 2  Person:11    (3rd)
Blind: 2  Person: 1    (2nd)

Blind: 3  Person: 4    (3rd)
Blind: 3  Person: 3    (2nd)

Blind: 4  Person:10    (2nd)
Blind: 4  Person: 6    (2nd)

---Hunter order is 4, 1, 5, 11, 10, 3, 7, 6, 12, 9, 8, 2, ---
08/23/08  Sat
          --------- starts over
Blind: 1  Person: 4    (4th)
Blind: 1  Person: 1    (3rd)

Blind: 2  Person: 5    (2nd)
Blind: 2  Person:11    (4th)

Blind: 3  Person:10    (3rd)
Blind: 3  Person: 3    (3rd)

Blind: 4  Person: 7    (2nd)
Blind: 4  Person: 6    (3rd)

Person  NoOfHunts
1       3
2       0
3       3
4       4
5       2
6       3
7       2
8       3
9       3
10      4
11      4
12      1
If I was person 2, I'd be pissed off at day 2!

Perhaps what is needed for the StringLists of hunters is to not random-sort the list until all hunters have been assigned to a blind, not per day. I'd also remove them from the list as they were assigned to prevent being put in a blind if they've already hunted.

Roo
Delphi Rules!
 
If I was person 2, I'd be pissed off at day 2!
Yep! that's why it has to be everyone gets used once and THEN it starts over again!

I'd also remove them from the list as they were assigned to prevent being put in a blind if they've already hunted.
that's what I was leaning towards but I can't seem to work out how to do that!

And I have noticed as I ran more tests that it eventually stops rotating and people are getting dropped out of the rotation.

It's basically every day and a half that the rotation should be used and then started over.

Thanks for all the suggestions, I'm sure I'll get it worked out eventually!

Leslie
 
agreed with the small sampling size, but if that is the issue, use a larger number :

(untested code)
Code:
function TForm_Main.GetHunters: TStringList;
var
  Sortkey: String;
  slHunters: TStringList;
begin
  slHunters:= TStringList.Create;
  Randomize;

  while slHunters.Count < 12 do  //number of hunters in group
  begin
    Sortkey:= IntToStr(Random(100000));
    // hunter resides in the objects[] list, list will be sorted on the sortkey items
    slHunters.AddObject(Sortkey, Pointer(slHunters.Count+1));

  end;
  slHunters.Sorted := true;
  Result:= slHunters;
  //slHunters.Free;
end;

// now modify the main routine:

          memo1.lines.add(Format('  %d Blind ' + IntToStr(i), [Integer(slTemp.objects[h]])));
          inc(h);
          if h > slTemp.Count - 1 then h := 0;
          memo1.lines.add(Format('  %d Blind ' + IntToStr(i), [Integer(slTemp.objects[h]])));
          inc(h);

Cheers,
Daddy

-----------------------------------------------------
What You See Is What You Get
Never underestimate tha powah of tha google!
 
Got it working as requested with the following:
Code:
unit Hunters;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls, Math, DateUtils;

type
  TForm_Main = class(TForm)
    Btn_Start: TButton;
    CheckBox1: TCheckBox;
    CheckBox2: TCheckBox;
    CheckBox3: TCheckBox;
    CheckBox4: TCheckBox;
    CheckBox5: TCheckBox;
    CheckBox6: TCheckBox;
    CheckBox7: TCheckBox;
    Memo1: TMemo;
    dtPickerStart: TDateTimePicker;
    dtPickerEnd: TDateTimePicker;
    procedure Btn_StartClick(Sender: TObject);
  private
    { Private declarations }
    function NumHunters(List: TStringList): integer;
    function GetHunters: TStringList;
    procedure AdvanceList(var List: TStringList);
  public
    { Public declarations }
  end;

var
  Form_Main: TForm_Main;

implementation

{$R *.dfm}

function TForm_Main.NumHunters(List: TStringList): integer;
begin
  result:= List.Count;
end;

function TForm_Main.GetHunters: TStringList;
//What I would like for it to do is random select
//two hunters for each blind each day,
var
  sTemp: string;
  slHunters: TStringList;
  i: integer;
begin
  slHunters:= TStringList.Create;
  Randomize;
  while slHunters.Count < 12 do begin //number of hunters in group
    sTemp:= IntToStr(RandomRange(1, 13)); // from 1 to number of hunters + 1
    if slHunters.IndexOf(sTemp) = -1 then
      slHunters.Add(sTemp);
  end;
  Result:= slHunters;
  sTemp:= 'Hunter order is ';
  for i:= 0 to slHunters.Count -1 do
    sTemp:= sTemp + slHunters[i] + ', ';
  Memo1.Lines.Add('---' + sTemp + '---');
end;

procedure TForm_Main.AdvanceList(var List: TStringList);
begin
  List.Delete(0);
  if NumHunters(List) <= 0 then
    List:= GetHunters
end;

procedure TForm_Main.Btn_StartClick(Sender: TObject);
//There are 12 hunters in this group.
//There are 4 blinds that they can use...2 hunters per blind per day.
//I have this code that does what needs to be done,
//but I don't like the fact that the pairings never changes
var
  Sday, Eday, blind: integer;
  h: integer;
  dtStart, dtEnd: TDateTime;
  slTemp: TStringList;
  AvailDays: set of 1..7;
begin
  AvailDays:= [];
  if CheckBox1.Checked then Include(AvailDays, 1);
  if CheckBox2.Checked then Include(AvailDays, 2);
  if CheckBox3.Checked then Include(AvailDays, 3);
  if CheckBox4.Checked then Include(AvailDays, 4);
  if CheckBox5.Checked then Include(AvailDays, 5);
  if CheckBox6.Checked then Include(AvailDays, 6);
  if CheckBox7.Checked then Include(AvailDays, 7);
  slTemp:= TStringList.Create;
  for h:= 1 to 12 do
    slTemp.Add(IntToStr(h));
  Memo1.Clear;
  dtStart:= dtPickerStart.Date;
  dtEnd:= dtPickerEnd.Date;
  //h := 0;
  Sday:= Trunc(dtStart);
  Eday:= Trunc(dtEnd);
  while Sday <= Eday do begin
    if DayOfTheWeek(Sday) in AvailDays then begin
      if NumHunters(slTemp) = 0 then slTemp:= GetHunters;
      for blind:= 1 to 4 do begin
        if blind = 1 then begin
          Memo1.Lines.Add(FormatDateTime('mm/dd/yy  ddd', Sday));
          Memo1.Lines.Add(EmptyStr);
        end;
        memo1.lines.add(Format('Blind:%2s  Person:%2s', [IntToStr(blind), slTemp[0]]));
        AdvanceList(slTemp);
        //inc(h);
        //if h > slTemp.Count - 1 then h:= 0;
        memo1.lines.add(Format('Blind:%2s  Person:%2s', [IntToStr(blind), slTemp[0]]));
        AdvanceList(slTemp);
        //inc(h);
        Memo1.Lines.Add(EmptyStr);
        //if h > slTemp.Count - 1 then h:= 0;
      end;
    end;
    Inc(sDay);
  end;
  slTemp.Free;
end;

end.

Roo
Delphi Rules!
 
I still see one minor flaw: When the list is re-scrambled mid-day, there is a chance that some hunters will hunt twice in same day. This could be avoided by creating a second list for each day and disallow duplicate hunters on the same day. A new challenge for you! This might work (Assume second list is DayList):

//where h = Hunter...
h:= 0;
While InDayList(DayList[h]) do inc(h);
memo1.lines.add(Format('Blind:%2s Hunter:%2s', [IntToStr(blind), slTemp[[red]h[/red]]]));
AdvanceList(h, slTemp); //slTemp.delete(h) instead of 0
DayList.Add(IntToStr(h));

See: thread102-1493100 for function InList().
Instead of another StringList, it could be another set of 1..12; (hunters) and use Include and Exclude.

It's been interesting... particularly all the views. Note I made no change to any of your "random" calls.

Roo
Delphi Rules!
 
I appreciate all the input! I'm not at the PC with Delphi so I can't check it now, but as soon as I can, I'll see what I can do!

It's an interesting puzzle, trying to make it fair and not repetitive at the same time. I'll be sure to let you know how it all works out and if I have any other questions, i'll be back!

Leslie
 
so where would you suggest I create DayList? I like that idea, but can't seem to put it all together!

I got the InList function from the other thread, and it looks like I'll need to change the parameter from a Word to an int?

Maybe it's just too early....[ponder]

Leslie




Leslie

Have you met Hardy Heron?
 
Ok, I had to change some things to prevent hunters from hunting twice in the same day. See comments in code. Complete revised code below:
Code:
unit Hunters;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls, Math, DateUtils;

type
  TForm_Main = class(TForm)
    Btn_Start: TButton;
    CheckBox1: TCheckBox;
    CheckBox2: TCheckBox;
    CheckBox3: TCheckBox;
    CheckBox4: TCheckBox;
    CheckBox5: TCheckBox;
    CheckBox6: TCheckBox;
    CheckBox7: TCheckBox;
    Memo1: TMemo;
    dtPickerStart: TDateTimePicker;
    dtPickerEnd: TDateTimePicker;
    procedure Btn_StartClick(Sender: TObject);
  private
    { Private declarations }
    DayList: TStringList;  //hunters assigned by day
    function InList(hunter: string): boolean;
    function NumHunters(List: TStringList): integer;
    function GetHunters: TStringList;
    procedure AdvanceList(Hunter: Integer; var List: TStringList);
  public
    { Public declarations }
  end;

var
  Form_Main: TForm_Main;

implementation

{$R *.dfm}

function TForm_Main.InList(hunter: string): boolean;
begin
  if Hunter = '' then  //assume if "blanked out" - then it's in the list (was assigned)
    result:= true      //  see: AdvanceList
  else
    result:= DayList.IndexOf(hunter) > -1;
end;

function TForm_Main.NumHunters(List: TStringList): integer;
var
  i, total: integer;
begin
  //result:= List.Count;  Wont work since we're no longer deleting in AdvanceList
  Total:= 0;
  for i:= 0 to List.Count -1 do
    if List[i] <> '' then inc(total);
  result:= total;
end;

procedure TForm_Main.AdvanceList(Hunter: Integer; var List: TStringList);
begin
  //List.Delete(Hunter);
  List[Hunter]:= '';  //dont delete it, just blank it out
  if NumHunters(List) <= 0 then
    List:= GetHunters
end;

function TForm_Main.GetHunters: TStringList;
//Randomly select two hunters for each blind / each day.
var
  sTemp: string;
  slHunters: TStringList;
  i: integer;
begin
  slHunters:= TStringList.Create;
  Randomize;
  while slHunters.Count < 12 do begin //number of hunters in group
    sTemp:= IntToStr(RandomRange(1, 13)); // from 1 to number of hunters + 1
    if slHunters.IndexOf(sTemp) = -1 then
      slHunters.Add(sTemp);
  end;
  Result:= slHunters;
  sTemp:= 'Hunter order is ';
  for i:= 0 to slHunters.Count -1 do
    sTemp:= sTemp + slHunters[i] + ', ';
  Memo1.Lines.Add('---' + sTemp + '---');
end;

procedure TForm_Main.Btn_StartClick(Sender: TObject);
//There are 12 hunters in this group.
//There are 4 blinds that they can use...2 hunters per blind per day.
var
  Sday, Eday, blind: integer;
  h: integer;
  dtStart, dtEnd: TDateTime;
  slTemp: TStringList;
  AvailDays: set of 1..7;
begin
  AvailDays:= [];
  if CheckBox1.Checked then Include(AvailDays, 1);
  if CheckBox2.Checked then Include(AvailDays, 2);
  if CheckBox3.Checked then Include(AvailDays, 3);
  if CheckBox4.Checked then Include(AvailDays, 4);
  if CheckBox5.Checked then Include(AvailDays, 5);
  if CheckBox6.Checked then Include(AvailDays, 6);
  if CheckBox7.Checked then Include(AvailDays, 7);
  slTemp:= TStringList.Create;
  DayList:= TStringList.Create;  //NEW - parent is form (tried as set - didn't work out)
  for h:= 1 to 12 do
    slTemp.Add(IntToStr(h));
  Memo1.Clear;
  dtStart:= dtPickerStart.Date;
  dtEnd:= dtPickerEnd.Date;
  Sday:= Trunc(dtStart);
  Eday:= Trunc(dtEnd);
  try
    while Sday <= Eday do begin
      if DayOfTheWeek(Sday) in AvailDays then begin
        for blind:= 1 to 4 do begin
          if blind = 1 then begin
            Memo1.Lines.Add(FormatDateTime('mm/dd/yy  ddd', Sday));
            Memo1.Lines.Add(EmptyStr);
            DayList.Clear;
          end;

          //put 1st hunter in this blind...
          h:= 0;
          while InList(slTemp[h]) and (h < 12) do
            inc(h);
          memo1.lines.add(Format('Blind:%2s  Person:%2s', [IntToStr(blind), slTemp[h]]));
          DayList.Add(slTemp[h]);  //put hunter in daylist
          AdvanceList(h, slTemp);  //must come AFTER daylist.add

          //repeat for 2nd hunter in this blind...
          //this could be proc - called twice
          h:= 0;
          while InList(slTemp[h]) and (h < 12) do
            inc(h);
          memo1.lines.add(Format('Blind:%2s  Person:%2s', [IntToStr(blind), slTemp[h]]));
          DayList.Add(slTemp[h]);  //put hunter in daylist
          AdvanceList(h, slTemp);

          Memo1.Lines.Add(EmptyStr);
        end;
      end;
      Inc(sDay);
    end;
  finally
    slTemp.Free;
    DayList.Free
  end
end;

end.
I was struggling for a while there, then discovered DayList.Add() had to be before AdvanceList(). You'll see why.

Happy hunting!

Roo
Delphi Rules!
 
wow, you deserve another couple of stars, a case of your favorite libation and a big hug!

Les
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top