《天天德州》之德州牛仔概率计算器

　　鹅厂的《天天德州》里有个相关的“小”游戏，名曰《牛仔》或《德州牛仔》。尽管其在游戏主界面上的入口并不很显眼，但它的设计却非常有创意，借德扑的规则行“涉赌”之擦边球玩法，简单来说，在假定系统公平的前提下，其完全就是靠统计、概率来获利的游戏。 综合考量其赔付设定及鹅厂的运营能量，即便其确实完全公平无猫腻（很明显这不可能），在收入等硬指标上恐怕也相当可观！

　　而我则对其系统赔付比比较感兴趣，在用排列组合方式计算出了“任一人手牌”的各项几率后，发现已较难再以相同做法计算“获胜牌型”几率，毕竟概率论基本已淡忘得差不多了，也不大想再费脑作这些繁琐计算，于是理所当然的，直接撸了个德州牛仔概率计算器程序，以“大数据”的方式来展示各项统计结果，如下。

　　此计算器的核心代码如下。

unit uTexasPoker;

interface

uses
  SysUtils, Windows;

type
  // 花色(红桃、方块、黑桃、梅花)
  TCardColor = (ccHearts, ccDiamond, ccSpades, ccClubs);

  // 输赢类型(牛仔赢、平局、公牛赢)
  TWinningType = (wtCowboy, wtTie, wtBull);

  // 手牌类型(同花、连牌、对子、同花连牌、对A、杂牌)
  THandCardType = (hctFlush, hctStraight, hctOnePair, hctFlushStraight, hctPairA, hctNone);

  // 手牌+公共牌最终所成牌型(高牌、一对、两对、三条、顺子、同花、葫芦、四条(金刚)、同花顺、皇家同花顺)
  TGameCardType = (gctHighCard, gctOnePair, gctTwoPair, gctThreeOfAKind, gctStraight, gctFlush, gctFullHouse, gctFourOfAKind, gctStraightFlush, gctRoyalFlush);

  TCardProp = record
    Value: Byte;
    Color: TCardColor;
  end;

  PPlayerCardType = ^TPlayerCardType;
  TPlayerCardType = record
    GameCardType: TGameCardType;
    CardValueArr: array[1..5] of Byte;
  end;

  PColoredCardArr = ^TColoredCardArr;
  TColoredCardArr = array[TCardColor, 1..14] of Byte;

const
  cCardPropLen                                      = SizeOf(TCardProp);
  cPlayerCardTypeLen                                = SizeOf(TPlayerCardType);
  cHandCardTypeDesc: array[THandCardType] of string = (‘同花‘, ‘连牌‘, ‘对子‘, ‘同花连牌‘, ‘对A‘, ‘普通‘);
  cGameCardTypeDesc: array[TGameCardType] of string = (‘高牌‘, ‘一对‘, ‘两对‘, ‘三条‘, ‘顺子‘, ‘同花‘, ‘葫芦‘, ‘金刚‘, ‘同花顺‘, ‘皇家同花顺‘);

type
  TExecutingCallback = procedure of object;
  TOutputCallback    = procedure(const S: string) of object;

  TTexasPoker = class
  private
    FDeckCards: array[1..52] of Byte;
    FCommCards: array[1..5] of Byte;
    FPlayerCards: array[1..4] of Byte;
    FHandCardProps: array[1..4] of TCardProp;
    FCowboyCards: TColoredCardArr;
    FBullCards: TColoredCardArr;
    FCowboyCardType: TPlayerCardType;
    FBullCardType: TPlayerCardType;
    FHandCardTypes: array[THandCardType] of Integer;
    FWinningTypes: array[TWinningType] of Integer;
    FWinCardTypes: array[TGameCardType] of Integer;
    FCowboyCardTypes: array[TGameCardType] of Integer;
    FBullCardTypes: array[TGameCardType] of Integer;
    procedure Reset;
    procedure Initialize;
    procedure GenCommCards;
    procedure GenPlayerCards;
    procedure NormalizePlayerCards;
    procedure StatHandCardTypes;
    procedure AnalysePlayerCardTypes;
    procedure ComparePlayerCardTypes;
    procedure OutputStats(const ExecNum: Integer; const OutputCallback: TOutputCallback);
  public
    constructor Create;
    destructor Destroy; override;
    procedure Execute(const ExecNum: Integer; const ExecutingCallback: TExecutingCallback; const OutputCallback: TOutputCallback);
    function CardValueFromIdx(Idx: Byte): Byte;
    function CardColorFromIdx(Idx: Byte): TCardColor;
  end;

implementation

{ TTexasPoker }

procedure TTexasPoker.AnalysePlayerCardTypes;

  function CheckRoyalFlush(const ColoredCardArr: PColoredCardArr; const PlayerCardType: PPlayerCardType): Boolean;
  var
    CardColor: TCardColor;
    I: Integer;
  begin
    for CardColor := Low(TCardColor) to High(TCardColor) do
    begin
      if (ColoredCardArr[CardColor][14] = 1) and (ColoredCardArr[CardColor][13] = 1) and (ColoredCardArr[CardColor][12] = 1)
        and (ColoredCardArr[CardColor][11] = 1) and (ColoredCardArr[CardColor][10] = 1)
      then
      begin
        PlayerCardType.GameCardType := gctRoyalFlush;
        for I := 1 to 5 do
          PlayerCardType.CardValueArr[I] := 14 - I + 1;
        Result := True;
        Exit;
      end;
    end;
    Result := False;
  end;

  function CheckStraightFlush(const ColoredCardArr: PColoredCardArr; const PlayerCardType: PPlayerCardType): Boolean;
  var
    CardColor: TCardColor;
    I, J: Integer;
  begin
    for I := 13 downto 5 do
    begin
      for CardColor := Low(TCardColor) to High(TCardColor) do
      begin
        if (ColoredCardArr[CardColor][I] = 1) and (ColoredCardArr[CardColor][I - 1] = 1) and (ColoredCardArr[CardColor][I - 2] = 1)
          and (ColoredCardArr[CardColor][I - 3] = 1) and (ColoredCardArr[CardColor][I - 4] = 1)
        then
        begin
          PlayerCardType.GameCardType := gctStraightFlush;
          for J := 1 to 5 do
            PlayerCardType.CardValueArr[J] := I - J + 1;
          Result := True;
          Exit;
        end;
      end;
    end;
    Result := False;
  end;

  function CheckFourOfAKind(const ColoredCardArr: PColoredCardArr; const PlayerCardType: PPlayerCardType): Boolean;
  var
    I, J: Integer;
  begin
    for I := 14 downto 2 do
    begin
      if (ColoredCardArr[ccHearts][I] = 1) and (ColoredCardArr[ccDiamond][I] = 1)
        and (ColoredCardArr[ccSpades][I] = 1) and (ColoredCardArr[ccClubs][I] = 1)
      then
      begin
        PlayerCardType.GameCardType := gctFourOfAKind;
        for J := 1 to 4 do
          PlayerCardType.CardValueArr[J] := I;
        for J := 14 downto 2 do
        begin
          if (J <> I)
            and ((ColoredCardArr[ccHearts][J] = 1) or (ColoredCardArr[ccDiamond][J] = 1) or (ColoredCardArr[ccSpades][J] = 1) or (ColoredCardArr[ccClubs][J] = 1))
          then
          begin
            PlayerCardType.CardValueArr[5] := J;
            Result := True;
            Exit;
          end;
        end;
      end;
    end;
    Result := False;
  end;

  function CheckFullHouse(const ColoredCardArr: PColoredCardArr; const PlayerCardType: PPlayerCardType): Boolean;
  var
    I, J, K: Integer;
  begin
    for I := 14 downto 2 do
    begin
      if ((ColoredCardArr[ccHearts][I] = 1) and (ColoredCardArr[ccDiamond][I] = 1) and (ColoredCardArr[ccSpades][I] = 1))
         or ((ColoredCardArr[ccHearts][I] = 1) and (ColoredCardArr[ccDiamond][I] = 1) and (ColoredCardArr[ccClubs][I] = 1))
         or ((ColoredCardArr[ccHearts][I] = 1) and (ColoredCardArr[ccSpades][I] = 1) and (ColoredCardArr[ccClubs][I] = 1))
         or ((ColoredCardArr[ccDiamond][I] = 1) and (ColoredCardArr[ccSpades][I] = 1) and (ColoredCardArr[ccClubs][I] = 1))
      then
      begin
        for J := 14 downto 2 do
        begin
          if J <> I then
          begin
            if ((ColoredCardArr[ccHearts][J] = 1) and (ColoredCardArr[ccDiamond][J] = 1))
              or ((ColoredCardArr[ccHearts][J] = 1) and (ColoredCardArr[ccSpades][J] = 1))
              or ((ColoredCardArr[ccHearts][J] = 1) and (ColoredCardArr[ccClubs][J] = 1))
              or ((ColoredCardArr[ccDiamond][J] = 1) and (ColoredCardArr[ccSpades][J] = 1))
              or ((ColoredCardArr[ccDiamond][J] = 1) and (ColoredCardArr[ccClubs][J] = 1))
              or ((ColoredCardArr[ccSpades][J] = 1) and (ColoredCardArr[ccClubs][J] = 1))
            then
            begin
              PlayerCardType.GameCardType := gctFullHouse;
              for K := 1 to 3 do
                PlayerCardType.CardValueArr[K] := I;
              PlayerCardType.CardValueArr[4] := J;
              PlayerCardType.CardValueArr[5] := J;
              Result := True;
              Exit;
            end;
          end;
        end;
      end;
    end;
    Result := False;
  end;

  function CheckFlush(const ColoredCardArr: PColoredCardArr; const PlayerCardType: PPlayerCardType): Boolean;
  var
    CardColor: TCardColor;
    I, Cnt: Integer;
  begin
    for CardColor := Low(TCardColor) to High(TCardColor) do
    begin
      Cnt := 0;
      for I := 14 downto 2 do
      begin
        if ColoredCardArr[CardColor][I] = 1 then
        begin
          Inc(Cnt);
          PlayerCardType.CardValueArr[Cnt] := I;
          if Cnt >= 5 then
            Break;
        end;
      end;
      if Cnt >= 5 then
      begin
        PlayerCardType.GameCardType := gctFlush;
        Result := True;
        Exit;
      end;
    end;
    Result := False;
  end;

  function CheckStraight(const ColoredCardArr: PColoredCardArr; const PlayerCardType: PPlayerCardType): Boolean;
  var
    I, J: Integer;
  begin
    for I := 14 downto 5 do
    begin
      if ((ColoredCardArr[ccHearts][I] = 1) or (ColoredCardArr[ccDiamond][I] = 1) or (ColoredCardArr[ccSpades][I] = 1) or (ColoredCardArr[ccClubs][I] = 1))
        and ((ColoredCardArr[ccHearts][I - 1] = 1) or (ColoredCardArr[ccDiamond][I - 1] = 1) or (ColoredCardArr[ccSpades][I - 1] = 1) or (ColoredCardArr[ccClubs][I - 1] = 1))
        and ((ColoredCardArr[ccHearts][I - 2] = 1) or (ColoredCardArr[ccDiamond][I - 2] = 1) or (ColoredCardArr[ccSpades][I - 2] = 1) or (ColoredCardArr[ccClubs][I - 2] = 1))
        and ((ColoredCardArr[ccHearts][I - 3] = 1) or (ColoredCardArr[ccDiamond][I - 3] = 1) or (ColoredCardArr[ccSpades][I - 3] = 1) or (ColoredCardArr[ccClubs][I - 3] = 1))
        and ((ColoredCardArr[ccHearts][I - 4] = 1) or (ColoredCardArr[ccDiamond][I - 4] = 1) or (ColoredCardArr[ccSpades][I - 4] = 1) or (ColoredCardArr[ccClubs][I - 4] = 1))
      then
      begin
        PlayerCardType.GameCardType := gctStraight;
        for J := 1 to 5 do
          PlayerCardType.CardValueArr[J] := I - J + 1;
        Result := True;
        Exit;
      end;
    end;
    Result := False;
  end;

  function CheckThreeOfAKind(const ColoredCardArr: PColoredCardArr; const PlayerCardType: PPlayerCardType): Boolean;
  var
    I, J, K: Integer;
  begin
    for I := 14 downto 2 do
    begin
      if ((ColoredCardArr[ccHearts][I] = 1) and (ColoredCardArr[ccDiamond][I] = 1) and (ColoredCardArr[ccSpades][I] = 1))
         or ((ColoredCardArr[ccHearts][I] = 1) and (ColoredCardArr[ccDiamond][I] = 1) and (ColoredCardArr[ccClubs][I] = 1))
         or ((ColoredCardArr[ccHearts][I] = 1) and (ColoredCardArr[ccSpades][I] = 1) and (ColoredCardArr[ccClubs][I] = 1))
         or ((ColoredCardArr[ccDiamond][I] = 1) and (ColoredCardArr[ccSpades][I] = 1) and (ColoredCardArr[ccClubs][I] = 1))
      then
      begin
        PlayerCardType.GameCardType := gctThreeOfAKind;
        for J := 1 to 3 do
          PlayerCardType.CardValueArr[J] := I;
        K := 4;
        for J := 14 downto 2 do
        begin
          if J <> I then
          begin
            if (ColoredCardArr[ccHearts][J] = 1) or (ColoredCardArr[ccDiamond][J] = 1) or (ColoredCardArr[ccSpades][J] = 1) or (ColoredCardArr[ccClubs][J] = 1) then
            begin
              PlayerCardType.CardValueArr[K] := J;
              Inc(K);
              if K > 5 then
              begin
                Result := True;
                Exit;
              end;
            end;
          end;
        end;
      end;
    end;
    Result := False;
  end;

  function CheckTwoPair(const ColoredCardArr: PColoredCardArr; const PlayerCardType: PPlayerCardType): Boolean;
  var
    I, J, Cnt: Integer;
  begin
    Cnt := 0;
    for J := 14 downto 2 do
    begin
      if ((ColoredCardArr[ccHearts][J] = 1) and (ColoredCardArr[ccDiamond][J] = 1))
        or ((ColoredCardArr[ccHearts][J] = 1) and (ColoredCardArr[ccSpades][J] = 1))
        or ((ColoredCardArr[ccHearts][J] = 1) and (ColoredCardArr[ccClubs][J] = 1))
        or ((ColoredCardArr[ccDiamond][J] = 1) and (ColoredCardArr[ccSpades][J] = 1))
        or ((ColoredCardArr[ccDiamond][J] = 1) and (ColoredCardArr[ccClubs][J] = 1))
        or ((ColoredCardArr[ccSpades][J] = 1) and (ColoredCardArr[ccClubs][J] = 1))
      then
      begin
        Inc(Cnt);
        PlayerCardType.CardValueArr[Cnt * 2 - 1] := J;
        PlayerCardType.CardValueArr[Cnt * 2] := J;
        if Cnt >= 2 then
        begin
          for I := 14 downto 2 do
          begin
            if (I <> PlayerCardType.CardValueArr[1]) and (I <> PlayerCardType.CardValueArr[3]) then
            begin
              if (ColoredCardArr[ccHearts][I] = 1) or (ColoredCardArr[ccDiamond][I] = 1) or (ColoredCardArr[ccSpades][I] = 1) or (ColoredCardArr[ccClubs][I] = 1) then
              begin
                PlayerCardType.GameCardType := gctTwoPair;
                PlayerCardType.CardValueArr[5] := I;
                Result := True;
                Exit;
              end;
            end;
          end;
        end;
      end;
    end;
    Result := False;
  end;

  function CheckOnePair(const ColoredCardArr: PColoredCardArr; const PlayerCardType: PPlayerCardType): Boolean;
  var
    I, J, Cnt: Integer;
  begin
    for J := 14 downto 2 do
    begin
      if ((ColoredCardArr[ccHearts][J] = 1) and (ColoredCardArr[ccDiamond][J] = 1))
        or ((ColoredCardArr[ccHearts][J] = 1) and (ColoredCardArr[ccSpades][J] = 1))
        or ((ColoredCardArr[ccHearts][J] = 1) and (ColoredCardArr[ccClubs][J] = 1))
        or ((ColoredCardArr[ccDiamond][J] = 1) and (ColoredCardArr[ccSpades][J] = 1))
        or ((ColoredCardArr[ccDiamond][J] = 1) and (ColoredCardArr[ccClubs][J] = 1))
        or ((ColoredCardArr[ccSpades][J] = 1) and (ColoredCardArr[ccClubs][J] = 1))
      then
      begin
        PlayerCardType.CardValueArr[1] := J;
        PlayerCardType.CardValueArr[2] := J;
        Cnt := 3;
        for I := 14 downto 2 do
        begin
          if I <> PlayerCardType.CardValueArr[1] then
          begin
            if (ColoredCardArr[ccHearts][I] = 1) or (ColoredCardArr[ccDiamond][I] = 1) or (ColoredCardArr[ccSpades][I] = 1) or (ColoredCardArr[ccClubs][I] = 1) then
            begin
              PlayerCardType.CardValueArr[Cnt] := I;
              Inc(Cnt);
              if Cnt > 5 then
              begin
                PlayerCardType.GameCardType := gctOnePair;
                Result := True;
                Exit;
              end;
            end;
          end;
        end;
      end;
    end;
    Result := False;
  end;

  function CheckHighCard(const ColoredCardArr: PColoredCardArr; const PlayerCardType: PPlayerCardType): Boolean;
  var
    I, Cnt: Integer;
  begin
    Result := True;
    PlayerCardType.GameCardType := gctHighCard;
    Cnt := 0;
    for I := 14 downto 2 do
    begin
      if (ColoredCardArr[ccHearts][I] = 1) or (ColoredCardArr[ccDiamond][I] = 1) or (ColoredCardArr[ccSpades][I] = 1) or (ColoredCardArr[ccClubs][I] = 1) then
      begin
        Inc(Cnt);
        PlayerCardType.CardValueArr[Cnt] := I;
        if Cnt >= 5 then
          Exit;
      end;
    end;
  end;

  function Analyse(const ColoredCardArr: PColoredCardArr; const PlayerCardType: PPlayerCardType): TGameCardType;
  begin
    if CheckRoyalFlush(ColoredCardArr, PlayerCardType) then
    begin
      Result := gctRoyalFlush;
      Exit;
    end;
    if CheckStraightFlush(ColoredCardArr, PlayerCardType) then
    begin
      Result := gctStraightFlush;
      Exit;
    end;
    if CheckFourOfAKind(ColoredCardArr, PlayerCardType) then
    begin
      Result := gctFourOfAKind;
      Exit;
    end;
    if CheckFullHouse(ColoredCardArr, PlayerCardType) then
    begin
      Result := gctFullHouse;
      Exit;
    end;
    if CheckFlush(ColoredCardArr, PlayerCardType) then
    begin
      Result := gctFlush;
      Exit;
    end;
    if CheckStraight(ColoredCardArr, PlayerCardType) then
    begin
      Result := gctStraight;
      Exit;
    end;
    if CheckThreeOfAKind(ColoredCardArr, PlayerCardType) then
    begin
      Result := gctThreeOfAKind;
      Exit;
    end;
    if CheckTwoPair(ColoredCardArr, PlayerCardType) then
    begin
      Result := gctTwoPair;
      Exit;
    end;
    if CheckOnePair(ColoredCardArr, PlayerCardType) then
    begin
      Result := gctOnePair;
      Exit;
    end;
    CheckHighCard(ColoredCardArr, PlayerCardType);
    Result := gctHighCard;
  end;

begin
  Inc(FCowboyCardTypes[Analyse(@FCowboyCards, @FCowboyCardType)]);
  Inc(FBullCardTypes[Analyse(@FBullCards, @FBullCardType)]);
end;

function TTexasPoker.CardColorFromIdx(Idx: Byte): TCardColor;
begin
  Result := TCardColor((Idx - 1) mod 4);
end;

function TTexasPoker.CardValueFromIdx(Idx: Byte): Byte;
begin
  Result := (Idx - 1) div 4 + 1;
end;

procedure TTexasPoker.ComparePlayerCardTypes;

  procedure CowboyWin;
  begin
    Inc(FWinningTypes[wtCowboy]);
    Inc(FWinCardTypes[FCowboyCardType.GameCardType]);
  end;

  procedure BullWin;
  begin
    Inc(FWinningTypes[wtBull]);
    Inc(FWinCardTypes[FBullCardType.GameCardType]);
  end;

  procedure PlayEven;
  begin
    Inc(FWinningTypes[wtTie]);
  end;

var
  I: Integer;
begin
  if FCowboyCardType.GameCardType > FBullCardType.GameCardType then
  begin
    CowboyWin;
    Exit;
  end;

  if FCowboyCardType.GameCardType < FBullCardType.GameCardType then
  begin
    BullWin;
    Exit;
  end;

  if FCowboyCardType.GameCardType = gctRoyalFlush then
  begin
    PlayEven;
    Exit;
  end;

  if (FCowboyCardType.GameCardType = gctStraightFlush) or (FCowboyCardType.GameCardType = gctStraight) then
  begin
    if FCowboyCardType.CardValueArr[1] > FBullCardType.CardValueArr[1] then
      CowboyWin
    else if FCowboyCardType.CardValueArr[1] < FBullCardType.CardValueArr[1] then
      BullWin
    else
      PlayEven;
    Exit;
  end;

  if (FCowboyCardType.GameCardType = gctFourOfAKind) or (FCowboyCardType.GameCardType = gctFullHouse) then
  begin
    if FCowboyCardType.CardValueArr[1] > FBullCardType.CardValueArr[1] then
      CowboyWin
    else if FCowboyCardType.CardValueArr[1] < FBullCardType.CardValueArr[1] then
      BullWin
    else
    begin
      if FCowboyCardType.CardValueArr[5] > FBullCardType.CardValueArr[5] then
        CowboyWin
      else if FCowboyCardType.CardValueArr[5] < FBullCardType.CardValueArr[5] then
        BullWin
      else
        PlayEven;
    end;
    Exit;
  end;

  if (FCowboyCardType.GameCardType = gctFlush) or (FCowboyCardType.GameCardType = gctHighCard) then
  begin
    for I := 1 to 5 do
    begin
      if FCowboyCardType.CardValueArr[I] > FBullCardType.CardValueArr[I] then
      begin
        CowboyWin;
        Exit;
      end
      else if FCowboyCardType.CardValueArr[I] < FBullCardType.CardValueArr[I] then
      begin
        BullWin;
        Exit;
      end;
    end;
    PlayEven;
    Exit;
  end;

  if FCowboyCardType.GameCardType = gctThreeOfAKind then
  begin
    if FCowboyCardType.CardValueArr[1] > FBullCardType.CardValueArr[1] then
      CowboyWin
    else if FCowboyCardType.CardValueArr[1] < FBullCardType.CardValueArr[1] then
      BullWin
    else
    begin
      if FCowboyCardType.CardValueArr[4] > FBullCardType.CardValueArr[4] then
        CowboyWin
      else if FCowboyCardType.CardValueArr[4] < FBullCardType.CardValueArr[4] then
        BullWin
      else
      begin
        if FCowboyCardType.CardValueArr[5] > FBullCardType.CardValueArr[5] then
          CowboyWin
        else if FCowboyCardType.CardValueArr[5] < FBullCardType.CardValueArr[5] then
          BullWin
        else
          PlayEven;
      end;
    end;
    Exit;
  end;

  if FCowboyCardType.GameCardType = gctTwoPair then
  begin
    if FCowboyCardType.CardValueArr[1] > FBullCardType.CardValueArr[1] then
      CowboyWin
    else if FCowboyCardType.CardValueArr[1] < FBullCardType.CardValueArr[1] then
      BullWin
    else
    begin
      if FCowboyCardType.CardValueArr[3] > FBullCardType.CardValueArr[3] then
        CowboyWin
      else if FCowboyCardType.CardValueArr[3] < FBullCardType.CardValueArr[3] then
        BullWin
      else
      begin
        if FCowboyCardType.CardValueArr[5] > FBullCardType.CardValueArr[5] then
          CowboyWin
        else if FCowboyCardType.CardValueArr[5] < FBullCardType.CardValueArr[5] then
          BullWin
        else
          PlayEven;
      end;
    end;
    Exit;
  end;

  if FCowboyCardType.GameCardType = gctOnePair then
  begin
    if FCowboyCardType.CardValueArr[1] > FBullCardType.CardValueArr[1] then
      CowboyWin
    else if FCowboyCardType.CardValueArr[1] < FBullCardType.CardValueArr[1] then
      BullWin
    else
    begin
      for I := 3 to 5 do
      begin
        if FCowboyCardType.CardValueArr[I] > FBullCardType.CardValueArr[I] then
        begin
          CowboyWin;
          Exit;
        end
        else if FCowboyCardType.CardValueArr[I] < FBullCardType.CardValueArr[I] then
        begin
          BullWin;
          Exit;
        end;
      end;
      PlayEven;
    end;
    Exit;
  end;end;

constructor TTexasPoker.Create;
begin

end;

destructor TTexasPoker.Destroy;
begin

  inherited;
end;

procedure TTexasPoker.Execute(const ExecNum: Integer; const ExecutingCallback: TExecutingCallback; const OutputCallback: TOutputCallback);
const
  cExecNumMin = 100000;
var
  I, Num: Integer;
begin
  Reset;
  Num := ExecNum;
  if Num < cExecNumMin then
  begin
    Num := cExecNumMin;
    if Assigned(OutputCallback) then
      OutputCallback(Format(‘【模拟次数合理变更：%d-->%d】‘, [ExecNum, Num]));
  end;
  for I := 1 to Num do
  begin
    if (I shr 7 = 0) and Assigned(ExecutingCallback) then
      ExecutingCallback;

    Initialize;
    GenCommCards;
    GenPlayerCards;
    NormalizePlayerCards;
    StatHandCardTypes;
    AnalysePlayerCardTypes;
    ComparePlayerCardTypes;
  end;

  if Assigned(OutputCallback) then
    OutputStats(Num, OutputCallback);
end;

procedure TTexasPoker.GenCommCards;
var
  RdnCnt: Integer;
  RdnIdx: Integer;
begin
  RdnCnt := 0;
  repeat
    RdnIdx := Random(52) + 1;
    if FDeckCards[RdnIdx] = 0 then
    begin
      FDeckCards[RdnIdx] := 1;
      FCommCards[RdnCnt + 1] := RdnIdx;
      Inc(RdnCnt);
    end;
  until RdnCnt >= Length(FCommCards);
end;

procedure TTexasPoker.GenPlayerCards;
var
  RdnCnt: Integer;
  RdnIdx: Integer;
begin
  RdnCnt := 0;
  repeat
    RdnIdx := Random(52) + 1;
    if FDeckCards[RdnIdx] = 0 then
    begin
      FDeckCards[RdnIdx] := 1;
      FPlayerCards[RdnCnt + 1] := RdnIdx;
      Inc(RdnCnt);
    end;
  until RdnCnt >= Length(FPlayerCards);
end;

procedure TTexasPoker.Initialize;
begin
  ZeroMemory(@FDeckCards, Length(FDeckCards));
  ZeroMemory(@FCommCards, Length(FCommCards));
  ZeroMemory(@FPlayerCards, Length(FPlayerCards));
  ZeroMemory(@FHandCardProps, Length(FHandCardProps) * cCardPropLen);
  ZeroMemory(@FCowboyCardType, cPlayerCardTypeLen);
  ZeroMemory(@FBullCardType, cPlayerCardTypeLen);
  ZeroMemory(@FCowboyCards, Length(FCowboyCards) * Length(FCowboyCards[Low(TCardColor)]));
  ZeroMemory(@FBullCards, Length(FBullCards) * Length(FBullCards[Low(TCardColor)]));
end;

procedure TTexasPoker.NormalizePlayerCards;
var
  I: Integer;
  C: TCardColor;
  V: Byte;
begin
  for I := Low(FPlayerCards) to High(FPlayerCards) do
  begin
    C := CardColorFromIdx(FPlayerCards[I]);
    V := CardValueFromIdx(FPlayerCards[I]);
    FHandCardProps[I].Color := C;
    FHandCardProps[I].Value := V;
    if I mod 2 = 1 then
    begin
      FCowboyCards[C][V] := 1;
      if V = 1 then
        FCowboyCards[C][14] := 1;
    end else
    begin
      FBullCards[C][V] := 1;
      if V = 1 then
        FBullCards[C][14] := 1;
    end;
  end;

  for I := Low(FCommCards) to High(FCommCards) do
  begin
    C := CardColorFromIdx(FCommCards[I]);
    V := CardValueFromIdx(FCommCards[I]);
    FCowboyCards[C][V] := 1;
    FBullCards[C][V] := 1;
    if V = 1 then
    begin
      FCowboyCards[C][14] := 1;
      FBullCards[C][14] := 1;
    end;
  end;
end;

procedure TTexasPoker.OutputStats(const ExecNum: Integer;
  const OutputCallback: TOutputCallback);
const
  cStatStr   = ‘    %12s  %12s  %12s  %12s‘;
  cStatStrEx = ‘    %25s  %12s  %12s  %12s‘;
  cSumStr    = ‘    %12s  %12s  %12s‘;
var
  HandCardType: THandCardType;
  Rate: Single;
  Cnt, WinLoseCnt: Integer;
  WinCardType: TGameCardType;
begin
  OutputCallback(‘‘);

  OutputCallback(‘  任一人手牌统计信息如下：‘);
  OutputCallback(Format(cStatStr, [‘牌型‘, ‘次数‘, ‘比例‘, ‘赔率‘]));
  OutputCallback(‘        --------------------------------------------------‘);
  for HandCardType := Low(FHandCardTypes) to High(FHandCardTypes) do
  begin
    Rate := FHandCardTypes[HandCardType] / ExecNum;
    OutputCallback(Format(cStatStr, [cHandCardTypeDesc[HandCardType], IntToStr(FHandCardTypes[HandCardType]), Format(‘%.6f‘, [Rate * 100]) + ‘%‘, Format(‘%.6f‘, [1 / Rate])]));
  end;

  OutputCallback(‘‘);
  OutputCallback(‘  获胜牌型统计信息如下：‘);
  OutputCallback(Format(cStatStrEx, [‘牌型‘, ‘次数‘, ‘比例‘, ‘赔率‘]));
  OutputCallback(‘       ----------------------------------------------------------------‘);
  WinLoseCnt := ExecNum - FWinningTypes[wtTie];
  Cnt := FWinCardTypes[gctHighCard] + FWinCardTypes[gctOnePair];
  OutputCallback(Format(cStatStrEx, [‘高牌/一对‘, IntToStr(Cnt), Format(‘%.6f‘, [(Cnt / WinLoseCnt) * 100]) + ‘%‘, Format(‘%.6f‘, [1 / (Cnt / WinLoseCnt)])]));
  Cnt := FWinCardTypes[gctTwoPair];
  OutputCallback(Format(cStatStrEx, [‘两对‘, IntToStr(Cnt), Format(‘%.6f‘, [(Cnt / WinLoseCnt) * 100]) + ‘%‘, Format(‘%.6f‘, [1 / (Cnt / WinLoseCnt)])]));
  Cnt := FWinCardTypes[gctFlush] + FWinCardTypes[gctStraight] + FWinCardTypes[gctThreeOfAKind];
  OutputCallback(Format(cStatStrEx, [‘三条/顺子/同花‘, IntToStr(Cnt), Format(‘%.6f‘, [(Cnt / WinLoseCnt) * 100]) + ‘%‘, Format(‘%.6f‘, [1 / (Cnt / WinLoseCnt)])]));
  Cnt := FWinCardTypes[gctFullHouse];
  OutputCallback(Format(cStatStrEx, [‘葫芦‘, IntToStr(Cnt), Format(‘%.6f‘, [(Cnt / WinLoseCnt) * 100]) + ‘%‘, Format(‘%.6f‘, [1 / (Cnt / WinLoseCnt)])]));
  Cnt := FWinCardTypes[gctFourOfAKind] + FWinCardTypes[gctStraightFlush] + FWinCardTypes[gctRoyalFlush];
  OutputCallback(Format(cStatStrEx, [‘金刚/同花顺/皇家同花顺‘, IntToStr(Cnt), Format(‘%.6f‘, [(Cnt / WinLoseCnt) * 100]) + ‘%‘, Format(‘%.6f‘, [1 / (Cnt / WinLoseCnt)])]));

  OutputCallback(‘‘);
  OutputCallback(‘  输赢统计信息如下：‘);
  OutputCallback(Format(cStatStr, [‘描述‘, ‘次数‘, ‘比例‘, ‘赔率‘]));
  OutputCallback(‘      ----------------------------------------------------‘);
  OutputCallback(Format(cStatStr, [‘牛仔获胜数‘, IntToStr(FWinningTypes[wtCowboy]), Format(‘%.6f‘, [(FWinningTypes[wtCowboy] / ExecNum) * 100]) + ‘%‘, Format(‘%.6f‘, [1 / (FWinningTypes[wtCowboy] / ExecNum)])]));
  OutputCallback(Format(cStatStr, [‘公牛获胜数‘, IntToStr(FWinningTypes[wtBull]), Format(‘%.6f‘, [(FWinningTypes[wtBull] / ExecNum) * 100]) + ‘%‘, Format(‘%.6f‘, [1 / (FWinningTypes[wtBull] / ExecNum)])]));
  OutputCallback(Format(cStatStr, [‘平局数‘, IntToStr(FWinningTypes[wtTie]), Format(‘%.6f‘, [(FWinningTypes[wtTie] / ExecNum) * 100]) + ‘%‘, Format(‘%.6f‘, [1 / (FWinningTypes[wtTie] / ExecNum)])]));

  OutputCallback(‘‘);
  OutputCallback(‘  获胜明细牌型统计信息如下：‘);
  OutputCallback(Format(cStatStr, [‘牌型‘, ‘次数‘, ‘比例‘, ‘赔率‘]));
  OutputCallback(‘      ----------------------------------------------------‘);
  for WinCardType := Low(FWinCardTypes) to High(FWinCardTypes) do
  begin
    Rate := FWinCardTypes[WinCardType] / ExecNum;
    if Rate > 0 then
      OutputCallback(Format(cStatStr, [cGameCardTypeDesc[WinCardType], IntToStr(FWinCardTypes[WinCardType]), Format(‘%.6f‘, [Rate * 100]) + ‘%‘, Format(‘%.6f‘, [1 / Rate])]))
    else
      OutputCallback(Format(cStatStr, [cGameCardTypeDesc[WinCardType], IntToStr(FWinCardTypes[WinCardType]), Format(‘%.6f‘, [Rate * 100]) + ‘%‘, ‘0%‘]));
  end;

  OutputCallback(‘‘);
  OutputCallback(‘  牛仔所中牌型统计信息如下：‘);
  OutputCallback(Format(cSumStr, [‘牌型‘, ‘次数‘, ‘比例‘]));
  OutputCallback(‘      --------------------------------------‘);
  for WinCardType := Low(FCowboyCardTypes) to High(FCowboyCardTypes) do
    OutputCallback(Format(cSumStr, [cGameCardTypeDesc[WinCardType], IntToStr(FCowboyCardTypes[WinCardType]), Format(‘%.6f‘, [FCowboyCardTypes[WinCardType] / ExecNum * 100]) + ‘%‘]));

  OutputCallback(‘‘);
  OutputCallback(‘  公牛所中牌型统计信息如下：‘);
  OutputCallback(Format(cSumStr, [‘牌型‘, ‘次数‘, ‘比例‘]));
  OutputCallback(‘      --------------------------------------‘);
  for WinCardType := Low(FBullCardTypes) to High(FBullCardTypes) do
    OutputCallback(Format(cSumStr, [cGameCardTypeDesc[WinCardType], IntToStr(FBullCardTypes[WinCardType]), Format(‘%.6f‘, [FBullCardTypes[WinCardType] / ExecNum * 100]) + ‘%‘]));

  OutputCallback(‘‘);
end;

procedure TTexasPoker.Reset;
begin
  ZeroMemory(@FHandCardTypes, Length(FHandCardTypes) * 4);
  ZeroMemory(@FWinningTypes, Length(FWinningTypes) * 4);
  ZeroMemory(@FHandCardTypes, Length(FHandCardTypes) * 4);
  ZeroMemory(@FCowboyCardTypes, Length(FCowboyCardTypes) * 4);
  ZeroMemory(@FBullCardTypes, Length(FBullCardTypes) * 4);
end;

procedure TTexasPoker.StatHandCardTypes;
var
  BoMatched: Boolean;
begin
  BoMatched := False;

  if (FHandCardProps[1].Color = FHandCardProps[3].Color)
    or (FHandCardProps[2].Color = FHandCardProps[4].Color)
  then
  begin
    Inc(FHandCardTypes[hctFlush]);
    BoMatched := True;
  end;

  if (Abs(FHandCardProps[1].Value - FHandCardProps[3].Value) = 1)
    or (Abs(FHandCardProps[2].Value - FHandCardProps[4].Value) = 1)
    or (Abs(FHandCardProps[1].Value - FHandCardProps[3].Value) = 12)
    or (Abs(FHandCardProps[2].Value - FHandCardProps[4].Value) = 12)
  then
  begin
    Inc(FHandCardTypes[hctStraight]);
    BoMatched := True;
  end;

  if (FHandCardProps[1].Value = FHandCardProps[3].Value) or (FHandCardProps[2].Value = FHandCardProps[4].Value) then
  begin
    Inc(FHandCardTypes[hctOnePair]);
    if ((FHandCardProps[1].Value = FHandCardProps[3].Value) and (FHandCardProps[1].Value = 1))
      or ((FHandCardProps[2].Value = FHandCardProps[4].Value) and (FHandCardProps[2].Value = 1))
    then
      Inc(FHandCardTypes[hctPairA]);
    BoMatched := True;
  end;

  if ((FHandCardProps[1].Color = FHandCardProps[3].Color) and ((Abs(FHandCardProps[1].Value - FHandCardProps[3].Value) = 1) or (Abs(FHandCardProps[1].Value - FHandCardProps[3].Value) = 12)))
    or ((FHandCardProps[2].Color = FHandCardProps[4].Color) and ((Abs(FHandCardProps[2].Value - FHandCardProps[4].Value) = 1) or (Abs(FHandCardProps[2].Value - FHandCardProps[4].Value) = 12)))
  then
  begin
    Inc(FHandCardTypes[hctFlushStraight]);
    BoMatched := True;
  end;

  if not BoMatched then
    Inc(FHandCardTypes[hctNone]);
end;

end.

　　后记：

　　　　1) 在玩了数百把德州牛仔后我还是“流失”了，虽然有厌恶其内傻瓜式机器人的因素，但主要还是因明显感受到了“猫腻”的存在，当然，也可能只是我的错觉吧，毕竟，多次发生极小概率的事件，也是有可能的——纯随机的东西谁也无法预测

　　　　2) 假定系统真正公平，在对这些几率熟悉后，其实还是有不小的几率赢余的（假定玩家“理性”），手牌同花、获胜牌型高牌/一对之类不用说，赌平局也是可以尝试的（100把对局里约出4次平局）

原文地址：https://www.cnblogs.com/ecofast/p/8338315.html

时间： 2024-10-05 11:37:21

《天天德州》之德州牛仔概率计算器的相关文章

题解-概率计算器

Problem 求给定式子的期望:题面 Solution 由于式子是由\(\max ,\min\)组成的,而这东西是基于比较大小的,所以我们需要想想在基于比较的情况下方便实现的东西 设\(f(x)\)表示式子小于等于\(x\)的概率,\(g(x)\)表示式子大于等于\(x\)的概率 则对于单个变量,易证有: \(f(x)=x\\g(x)=1-f(x)\) 对于式子\(\max(x_1,x_2)\) \[f(x)=f_1(x)\cdot f_2(x)\] \[g(x)=1-f_1(x)\cdot

用quick制作仿PkrCruncher

将自己写的一段代码贴上来,抽取的是业务逻辑层,结构比较完整,我将太具体的东西都删除掉了.里面有tableview,帧动画,替换精灵图片,获取系统时间. local CalWinRateScene = class("CalWinRateScene", function()                             return display.newScene("CalWinRateScene")                         end)

2016年浙江财经大学信工学院程序设计竞赛题解

代码为本人出于爱好 验题时所写,如有错误,敬请指出. 题面$pdf$为本人排版,不到之处,还请海涵.  联系方式$QQ$:$774388357$  浙江财经大学 $14$软件工程 周甄陶 正赛题面:https://pan.baidu.com/s/1jIQASxo 热身赛题面:https://pan.baidu.com/s/1mi4mjMg 热身赛$pdf$密码:IbcS3jJkkOsxiMCYfF6v 弱校现场赛$Rank$:https://pan.baidu.com/s/1kVBFGMV 热身

Echarts Map地图类型使用

使用的时候出现了一个BUG, China地图的底色没有绘制出来,现在把一个小的DEMO给大家,以供参考,并附上参考文章(http://blog.csdn.net/danielinbiti/article/details/44851781),祝好. <!DOCTYPE html> <head> <meta charset="utf-8"> <title>ECharts</title> </head> <body

URAL 1936 Roshambo 题解

http://acm.timus.ru/problem.aspx?space=1&num=1936 F - Roshambo Time Limit:1000MS Memory Limit:65536KB 64bit IO Format:%I64d & %I64u Submit Status Practice URAL 1936 Description Bootstrap: Wondering how it's played? Will: It's a game of deception.

火车票起售时间

http://www.12306.cn/mormhweb/zxdt/201411/t20141126_2316.html 关于调整互联网.电话订票起售时间的公告 [2014-11-26] 自2014年11月28日起,铁路部门将对互联网.电话订票的起售时间进行调整.放票时间点从16个调整为21个,即8:00至18:00期间,每个整点和半点均有新票起售,同时C.D.G字头列车不再单独起售,起售时间与车站保持一致,具体方案如下: 8:00 起售车站 北京西.南京.南京南. 8:30 起售车站 白城.成

火车票购买技巧

又到了春运,火车票格外的难抢,然而我对火车票的流程还不懂,这明天可怎么帮女朋友抢票啊...嗯,这里就学习以下吧. 第一部分:火车票购票的几种方式 一般,火车票分为网上订票(pc端和移动端). 电话订票.火车站窗口.代售点订票以及自动售票机这几种方式. 1.网上订票.   网上订票即在 12306官网 上或者在手机客户端上买票.我们可以通过 互联网.电话订票起售时间 来查询不同地区火车站的放票时间,以便于及时抢票. 一般网上订票的预售期为30天或者60天,具体时间我们需要在12306官网上自行确定

json省市级联

代码: <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN"> <html> <head> <base href="<%=basePath%>"> <title>My JSP 'MyJsp.jsp' starting page</title> <meta http-equiv="Content-T

json级联城市

代码: <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN"> <html> <head> <base href="<%=basePath%>"> <title>My JSP 'MyJsp.jsp' starting page</title> <meta http-equiv="Content-T