[Back to MISC SWAG index]  [Back to Main SWAG index]  [Original]

{
JL>  #2: Another thing, I've got this cool Lotto program where I would like to
  >  a date file where the user can enter the weeks winning lotto numbers, then
  >  after a collection of weeks is made (say 10), the computer will read all t
  >  numbers in the file and compile a list of the most frequently ocurring num
  >  and print them out to the screen. I'm having trouble reading from and writ
  >  to the file. (I'll tackle the list compiling once that is straightened out
  >  help?

  Oh Boy, Lotto programs, the concept is pregnant with possibilities!
  Ever wonder why someone with a lotto program would sell it and not
  just win all the lottos? :)

  Ok, you want a frequency analyzer. Here's a start that will let you
  enter numbers and give a frequency table of all the numbers to date
  (hey, this is kinda fun, maybe I'll go into the lottery seminar
  bidness. Look out, Becky Paul!):
}

{$i-}
uses
  crt;

const
  MAX = 49;

type
  tFreqArray= array[0..MAX] of word;

var
  freqArray : tFreqArray;

{----------------------}
procedure InitFreqArray;
{ Read data file into array. If not found, zero all accumulators. }

var
  FreqF : file of tFreqArray;

begin
  assign(FreqF,'lotto.dat');
  reset(FreqF);
  if (ioresult=0) then begin
    read(Freqf,freqArray);
    close(freqF);
  end else fillchar(FreqArray,sizeof(FreqArray),0);
end;

{----------------------}
procedure SaveFreqArray;
var
  FreqF : file of tFreqArray;

begin
  assign(FreqF,'lotto.dat');
  rewrite(FreqF);
  write(Freqf,freqArray);
  close(freqF);
end;

{----------------------}
procedure PrintFrequencyTable;

type
  tPickRec=record
    Number : byte;
    Freq : word;
  end;
  tPickArray=array[0..MAX] of tPickRec;

var
  PickArray : tPickArray;

{-----------}
procedure SortPickArray;

{-----------}
procedure Swap(One,TheOther : byte);
var
  tmp : tPickRec;

begin
  tmp:= PickArray[One];
  PickArray[One]:= PickArray[TheOther];
  PickArray[TheOther]:= tmp;
end;

{----------}
var
  i,j,min : byte;

begin
  for i:= 0 to pred(MAX) do begin
    min:= i;
    for j:= succ(i) to MAX do
      if (PickArray[j].freq > PickArray[min].freq) then  min:= j;
    if (min>i) then Swap(i,min);
  end;
end; {SortPickArray}

{--------}
var
  i : byte;

begin
  for i:= 0 to MAX do with PickArray[i] do begin
    Number:= i;
    Freq:= FreqArray[i];
  end;

  SortPickArray;
  clrscr;
  writeln;
  writeln('Frequency Table:');
  for i:= 0 to 9 do
    writeln(PickArray[i].Number   :7,': ',PickArray[i].Freq   :5,' ',
            PickArray[i+10].Number:7,': ',PickArray[i+10].Freq:5,' ',
            PickArray[i+20].Number:7,': ',PickArray[i+20].Freq:5,' ',
            PickArray[i+30].Number:7,': ',PickArray[i+30].Freq:5,' ',
            PickArray[i+40].Number:7,': ',PickArray[i+40].Freq:5,' ');

end; {PrintFrequencyTable}

{----------------------}
procedure GetLottoNumbers;
var
  OneNumber : byte;
  Test : integer;
  s : string;

begin
  PrintFrequencyTable;
  repeat
    writeln;
    write('Enter lotto number (<=',MAX,', Enter to quit): ');
    readln(s);
    if (s<>'') then begin
      val(s,OneNumber,test);
      if (test=0) then begin
        inc(FreqArray[OneNumber]);
        PrintFrequencyTable;
      end;
    end;
  until (s='');

end; {GetLottoNumbers}
begin
  InitFreqArray;
  GetLottoNumbers;
  SaveFreqArray;
end.

[Back to MISC SWAG index]  [Back to Main SWAG index]  [Original]