From: Emlyn O'regan (oregan.emlyn@healthsolve.com.au)
Date: Tue Oct 29 2002 - 16:59:37 MST
A couple of extra points:
> I thought Emlyn's estimate was rather ingenious, but no, it didn't
> take that into account
(answered elsewhere)
> nor were his numbers exact, but it was an
> interesting shortcut approach that gets damn close to the right
> answer
If I ran it for long enough, the precision would be pretty high.
> with a lot less work.
Well, I wonder... you be the judge.
Emlyn
-----------------------------------------
unit fu_TestCF;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ComCtrls, StdCtrls, ExtCtrls;
type
TfrmTestCF = class(TForm)
Label1: TLabel;
rgBias: TRadioGroup;
edRuns: TEdit;
sbMain: TStatusBar;
Label2: TLabel;
edResult: TEdit;
btnCalc: TButton;
rgLessThan5: TRadioGroup;
Label3: TLabel;
procedure btnCalcClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
frmTestCF: TfrmTestCF;
implementation
uses math;
{$R *.DFM}
procedure TfrmTestCF.btnCalcClick(Sender: TObject);
var
dblTailProbSum: double;
darrCoinflips: array [0..19] of integer;
intRuns: integer;
intRunCount, intFlipCount: integer;
intRemovedCount: integer;
intTails, intHeads: integer;
bRedoTrial: boolean;
intStep: integer;
cursSave: TCursor;
begin
sbMain.SimpleText := '';
edResult.Text := '';
cursSave := screen.Cursor;
screen.Cursor := crHourglass;
try
intRuns := StrToInt(edRuns.text) * 1000;
except
intRuns := 0;
end;
if intRuns > 0 then
begin
randomize;
dblTailProbSum := 0;
intStep := max(intRuns div 100, 1);
for intRunCount := 0 to intRuns-1 do
begin
if (intRunCount mod intStep) = 0 then
begin
sbMain.SimpleText := 'Run ' + IntToStr(intRunCount);
Application.ProcessMessages;
end;
bRedoTrial := true;
while bRedoTrial do
begin
bRedoTrial := false;
for intFlipCount := 0 to 19 do
begin
if (Random < 0.5) then
darrCoinFlips[intFlipCount] := 0
else
darrCoinFlips[intFlipCount] := 1;
end;
intRemovedCount := 0;
if rgBias.ItemIndex = 0 then
begin
// biased
// first remove heads
intFlipCount := 0;
while (intRemovedCount < 5) and (intFlipCount < 20) do
begin
if darrCoinFlips[intFlipCount] = 1 then
begin
darrCoinFlips[intFlipCount] := -1;
inc(intRemovedCount);
end;
inc(intFlipCount);
end;
if rgLessThan5.ItemIndex = 0 then
begin
// allow less than 5 heads in biased sample
// now remove tails when no heads left and haven't
removed enough
intFlipCount := 0;
while (intRemovedCount < 5) and (intFlipCount < 20)
do
begin
if darrCoinFlips[intFlipCount] > -1 then
begin
darrCoinFlips[intFlipCount] := -1;
inc(intRemovedCount);
end;
inc(intFlipCount);
end;
// must be fifteen flips left.
end
else
begin
// don't allow less than 5 heads in biased sample
// redo the trial if there were less than 5 heads in
total.
bRedoTrial := (intRemovedCount < 5);
end;
end
else
begin
// unbiased
// just remove the first 5 coin flips
intFlipCount := 0;
while (intFlipCount < 5) do
begin
darrCoinFlips[intFlipCount] := -1;
inc(intFlipCount);
end;
end;
end;
// now count up frequencies and calc probability from
// values that are greater than -1.
intHeads := 0;
intTails := 0;
for intFlipCount := 0 to 19 do
begin
if darrCoinFlips[intFlipCount] = 0 then
inc(intTails)
else if darrCoinFlips[intFlipCount] = 1 then
inc(intHeads);
end;
// Now calculate the result
dblTailProbSum := dblTailProbSum + (intTails / (intHeads +
intTails));
end;
// now calculate and report the results.
edResult.Text := format('%.4f', [dblTailProbSum / intRuns]);
sbMain.SimpleText := 'Calculation Complete.';
end
else
begin
sbMain.SimpleText := 'Number of Runs must be an integer.';
end;
screen.Cursor := cursSave;
end;
end.
-----------------------------------------
***************************************************************************
Confidentiality: The contents of this email are confidential and are
intended only for the named recipient. If the reader of this e-mail is not
the intended recipient you are hereby notified that any use, reproduction,
disclosure or distribution of the information contained in the e-mail is
prohibited. If you have received this e-mail in error, please reply to us
immediately and delete the document.
Viruses: Any loss/damage incurred by using this material is not the sender's
responsibility. Our entire liability will be limited to resupplying the
material. No warranty is made that this material is free from computer virus
or other defect.
This archive was generated by hypermail 2.1.5 : Sat Nov 02 2002 - 09:17:52 MST