Källkod för sannolikhetssimulator - main.pas

unit main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls, ComCtrls, XPMan, Menus, CaptionGroup;

type

  TScenario = (sChangeNot, sChange);
  TDoor = 1..3;

  TmainFrm = class(TForm)
    cgInfo: TCaptionGroup;
    lblInfo: TLabel;
    reInfo: TRichEdit;
    XPManifest: TXPManifest;
    imgTitle: TImage;
    bevelTop: TBevel;
    shpBk: TShape;
    cgControls: TCaptionGroup;
    btnDoNotChange: TButton;
    btnDoChange: TButton;
    btnShowResult: TButton;
    lblControlDescr1: TLabel;
    lblControlDescr2: TLabel;
    lblControlDescr3: TLabel;
    MenuBar: TMainMenu;
    mnuTest: TMenuItem;
    mnuTestChangeNot: TMenuItem;
    mnuTestChange: TMenuItem;
    mnuTestResult: TMenuItem;
    space1: TMenuItem;
    mnuTestClose: TMenuItem;
    mnuHelp: TMenuItem;
    mnuHelpAbout: TMenuItem;
    lblNum1: TLabel;
    lblNum2: TLabel;
    lblNum3: TLabel;
    lblCopyright: TLabel;
    procedure psMessageBox(MessageText: string);
    procedure FormCreate(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure UserClose(Sender: TObject);
    procedure ShowAbout(Sender: TObject);
    procedure ComputeScenario(Scenario: TScenario);
    function FormatData(Scenario: TScenario): string;
    procedure SimulateCaseChangeNot(Sender: TObject);
    procedure SimulateCaseChange(Sender: TObject);
    procedure ShowResults(Sender: TObject);
    procedure mnuTestClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

const
  psGetVersion = '1.0.0.0';
  wsLine = #13#10;

var
  mainFrm: TmainFrm;
  scenarioNameChangeNot,
  scenarioNameChange: string;
  n1, n2, w1, w2: integer;
  p1, p2: extended;
  e1, e2: boolean;

implementation

uses aboutWin, InternalFunctionInputWin, message, progress, Math;

{$R *.dfm}

procedure TmainFrm.psMessageBox(MessageText: string);
begin
  with TmessageFrm.Create(self) do
    try
      i.caption := MessageText;
      ShowModal;
    finally
      free;
    end;
end;

procedure TmainFrm.FormCreate(Sender: TObject);
begin

  // Show information
  reInfo.Lines.Text := 'Individ I har vunnit en tävling och får därför tävla om en bil. Tävlingsledaren presenterar för I tre stycken dörrar: A, B och C. Bakom två av dörrarna finns leksaksbilar och bakom en av dörrarna finns den riktiga bilen. Individ I väljer dörr A.' + ' Sedan öppnar tävlingsledaren den dörr av de I inte har valt som innehåller en av leksaksbilarna, B. För att få maximalt hög sannolikhet att få den riktiga bilen, ska individ I stå kvar vid dörr A eller byta till dörr C?';

  // Init Random functions
  Randomize;

  // Init variables
  scenarioNameChange := 'dörrbyte';
  scenarioNameChangeNot := 'ej dörrbyte';
  e1 := false;
  e2 := false;
  
end;

procedure TmainFrm.FormResize(Sender: TObject);
begin
  reInfo.Repaint;
end;

procedure TmainFrm.UserClose(Sender: TObject);
begin
  Close;
end;

procedure TmainFrm.ShowAbout(Sender: TObject);
begin
  with Tabout.Create(self) do
    try
      ShowModal;
    finally
      free;
    end;
end;

// Simulates a scenario
procedure TmainFrm.ComputeScenario(Scenario: TScenario);
var
  n, w: ^integer; // n = number of repetitions; w = number of successes
  p: ^extended;   // p = probability of success = w/n
  i: integer;
  d, c: TDoor;
begin

  case Scenario of
    sChangeNot: begin
                  n := @n1;
                  w := @w1;
                  p := @p1;
                end;
    sChange:    begin
                  n := @n2;
                  w := @w2;
                  p := @p2;
                end;
  end;

  with TprogressFrm.Create(self) do
    try

      Show;
      ProgressBar.Min := 1;
      if n^ > 0 then
        ProgressBar.Max := n^;
      ProgressBar.Step := 100000;


      w^ := 0;
      for i := 1 to n^ do
      begin

        d := RandomRange(1,4); // The Right Door
        c := RandomRange(1,4); // Selected Door

        // Change door
        if Scenario = sChange then
          case c of
            1: begin
                 if d <> 2 then c := 3 else {if d <> 3 then} c := 2;
               end;
            2: begin
                 if d <> 1 then c := 3 else {if d <> 3 then} c := 1;
               end;
            3: begin
                 if d <> 2 then c := 1 else {if d <> 1 then} c := 2;
               end
          end;

        if d=c then inc(w^);

        if (i mod 100000) = 0 then ProgressBar.StepIt;

      end;

    finally
      close;
      free;
    end;

  p^ := w^/n^;  

end;

// Creates a string with results
function TmainFrm.FormatData(Scenario: TScenario): string;
var
  ScenarioName: ^string;
  n, w: ^integer;
  p: ^extended;
begin

  case Scenario of
    sChangeNot: begin
                  ScenarioName := @scenarioNameChangeNot;
                  n := @n1;
                  w := @w1;
                  p := @p1;
                end;
    sChange:    begin
                  ScenarioName := @scenarioNameChange;
                  n := @n2;
                  w := @w2;
                  p := @p2;
                end;
  end;

  result := AnsiUpperCase(ScenarioName^) + wsLine + 'Antal repetitioner=' + IntToStr(n^) + wsLine + 'Antal vinster=' + IntToStr(w^) + wsLine + 'P(vinst)=' + FloatToStr(p^);    

end;

procedure TmainFrm.SimulateCaseChangeNot(Sender: TObject);
begin

  // Inform
  psMessageBox('Scenariot där individ I inte byter dörr kommer nu att upprepas ett flertal gånger, och antalet vinster kommer att sparas. Sedan bestäms sannolikheten för att vinna den riktiga bilen.');

  // Get data
  with TInternalFunctionInput.Create(self) do
    try
      q.Caption := 'Ange antalet repetitioner av scenariot. Högre antal ger säkrare resultat. 10000000 rekommenderas.';
      A.Text := '10000000';
      if ShowModal = mrOk then
        try
          if StrToInt(A.Text) > 0 then
            n1 := StrToInt(A.Text)
          else
            Exit;
        except
          Exit;
        end
      else
        Exit;
    finally
      free;
    end;             

  // Compute probability
  ComputeScenario(sChangeNot);

  // Present data
  psMessageBox(FormatData(sChangeNot));

  // Simulation 1 done
  e1 := true;

  btnShowResult.enabled := e1 and e2;
  lblNum3.enabled := btnShowResult.enabled;
  lblControlDescr3.enabled := btnShowResult.enabled;

end;

procedure TmainFrm.SimulateCaseChange(Sender: TObject);
begin

  // Inform
  psMessageBox('Scenariot där individ I byter dörr kommer nu att upprepas ett flertal gånger, och antalet vinster kommer att sparas. Sedan bestäms sannolikheten för att vinna den riktiga bilen.');

  // Get data
  with TInternalFunctionInput.Create(self) do
    try
      q.Caption := 'Ange antalet repetitioner av scenariot. Högre antal ger säkrare resultat. 10000000 rekommenderas.';
      A.Text := '10000000';
      if ShowModal = mrOk then
        try
          if StrToInt(A.Text) > 0 then
            n2 := StrToInt(A.Text)
          else
            Exit;
        except
          Exit;
        end
      else
        Exit;
    finally
      free;
    end;

  // Compute probability
  ComputeScenario(sChange);

  // Present data
  psMessageBox(FormatData(sChange));

  // Simulation 2 done
  e2 := true;

  btnShowResult.enabled := e1 and e2;  
  lblNum3.enabled := btnShowResult.enabled;
  lblControlDescr3.enabled := btnShowResult.enabled;
  
end;

procedure TmainFrm.ShowResults(Sender: TObject);
var
  ResultText: string;
begin

  ResultText := FormatData(sChangeNot) + wsLine + wsLine +
                FormatData(sChange) + wsLine + wsLine +
                'Slutsats: ';

  if p1=p2 then
    ResultText := ResultText + 'P(vinst, EJ DÖRRBYTE)=P(vinst, DÖRRBYTE)'
  else if p1>p2 then
    ResultText := ResultText + 'P(vinst, EJ DÖRRBYTE)>P(vinst, DÖRRBYTE)'
  else {if p1<p2 then}
    ResultText := ResultText + 'P(vinst, DÖRRBYTE)>P(vinst, EJ DÖRRBYTE)';

  psMessageBox(ResultText);  

end;

procedure TmainFrm.mnuTestClick(Sender: TObject);
begin
  mnuTestResult.enabled := btnShowResult.enabled;
end;

end.

Copyright © 2004 Andreas Rejbrand