Описание базовых функций (C) Korovin corp.

procedure KartOut(k: integer);
begin
  ArKard[k]:=ArKard[k]-1; NumKar:=NumKar-1;
end;

procedure KartInp(k: integer);
begin
  ArKard[k]:=ArKard[k]+1; NumKar:=NumKar+1;
end;

function mDil2(fi,sd,td: Integer): Double;
  var i,fd,ts,tt: Integer; v: Double;
begin Result:=0;
  for i:=1 to 10 do if ArKard[i]>0 then begin ts:=sd+i; 
    if (ts<12) and ((i=1) or (td=1)) then tt:=1 else tt:=0; 
    fd:=ts+tt*10; if (fd>16) then begin
      if (fd>21)  or (fd<fi) then Result:=Result+ArKard[i]/NumKar;
      if (fd<22) and (fd>fi) then Result:=Result-ArKard[i]/NumKar;
    end else begin v:=ArKard[i]/NumKar; KartOut(i);
      Result:=Result+mDil2(fi,ts,tt)*v; KartInp(i); 
    end;
  end;
end;

//Европейские правила
function mDil1(si,ti,sd: Integer): Double;
  var i,fi,fd,ts,tt: Integer; v: Double;
begin Result:=0; fi:=si+ti*10;
  for i:=1 to 10 do if ArKard[i]>0 then begin ts:=sd+i;
    if (ts<12) and ((i=1) or (sd=1)) then tt:=1 else tt:=0; 
    fd:=ts+tt*10; if (fd>16) then begin
      if (fd>21) or (fd<fi) then Result:=Result+ArKard[i]/NumKar;
      if (fd>fi) or (fd=21) then Result:=Result-ArKard[i]/NumKar;
    end else begin v:=ArKard[i]/NumKar; KartOut(i);
      Result:=Result+mDil2(fi,ts,tt)*v; KartInp(i); 
    end;
 end;
end;

//Американские правила
function mDil1(si,ti,sd: Integer): Double;
  var i,fi,fd,ts,tt: Integer; v: Double;
begin Result:=0; fi:=si+ti*10;
  if sd=1 then begin
    for i:=1 to 9 do if ArKard[i]>0 then begin ts:=sd+i;
      if (ts<12) and ((i=1) or (sd=1)) then tt:=1 else tt:=0;
      fd:=ts+tt*10; if (fd>16) then begin
        if (fd<fi) then Result:=Result+ArKard[i]/(NumKar-ArKard[10]);
        if (fd>fi) then Result:=Result-ArKard[i]/(NumKar-ArKard[10]);
      end else begin v:=ArKard[i]/(NumKar-ArKard[10]); KartOut(i);
        Result:=Result+mDil2(fi,ts,tt)*v; KartInp(i);
      end;
    end;
  end else if sd=10 then begin
    for i:=2 to 10 do if ArKard[i]>0 then begin ts:=sd+i;
      if (ts<12) and ((i=1) or (sd=1)) then tt:=1 else tt:=0;
        fd:=ts+tt*10; if (fd>16) then begin
        if (fd<fi) then Result:=Result+ArKard[i]/(NumKar-ArKard[1]);
        if (fd>fi) then Result:=Result-ArKard[i]/(NumKar-ArKard[1]);
      end else begin v:=ArKard[i]/(NumKar-ArKard[1]); KartOut(i);
        Result:=Result+mDil2(fi,ts,tt)*v; KartInp(i);
      end;
    end;
  end else begin
    for i:=1 to 10 do if ArKard[i]>0 then begin ts:=sd+i;
      if (ts<12) and ((i=1) or (sd=1)) then tt:=1 else tt:=0;
        fd:=ts+tt*10; if (fd>16) then begin
        if (fd<fi) then Result:=Result+ArKard[i]/NumKar;
        if (fd>fi) then Result:=Result-ArKard[i]/NumKar;
      end else begin v:=ArKard[i]/NumKar; KartOut(i);
        Result:=Result+mDil2(fi,ts,tt)*v; KartInp(i);
      end;
    end;
  end;
end;

function mDubl(si,ti,sd: Integer): Double;
  var i,ts,tt: Integer; v: Double;
begin Result:=0;
  for i:=1 to 10 do if ArKard[i]>0 then begin ts:=si+i;
    if (ts<12) and ((i=1) or (ti=1)) then tt:=1 else tt:=0;
    if (ts>21) then Result:=Result-2*ArKard[i]/NumKar
    else begin v:=ArKard[i]/NumKar;       KartOut(i);
      Result:=Result+2*mDil1(ts,tt,sd)*v; KartInp(i); 
    end;
  end;
end;

function mHits(si,ti,sd: Integer): Double;
  var i,ts,tt: Integer; v: Double;
begin Result:=0; 
  for i:=1 to 10 do if ArKard[i]>0 then begin ts:=si+i;
    if (ts<12) and ((i=1) or (ti=1)) then tt:=1 else tt:=0;
    if (ts>21) then Result:=Result-ArKard[i]/NumKar 
    else begin v:=ArKard[i]/NumKar; KartOut(i); 
      Result:=Result+max(mDil1(ts,tt,sd),mHits(ts,tt,sd))*v; 
      KartInp(i); 
    end;
  end;
end;

function mSplt(si,sd,sp: Integer): Double;
  var i,ts,tt: Integer; h,d,s,p: Double;
begin Result:=0;
  for i:=1 to 10 do if ArKard[i]>0 then begin KartOut(i); ts:=si+i;
    if (i=1) or (si=1) then tt:=1 else tt:=0; s:=mDil1(ts,tt,sd); 
    if (si<>1) then h:=mHits(ts,tt,sd) else h:=-5;
    if (si<>1) then d:=mDubl(ts,tt,sd) else d:=-5;
    if (i =si) and (sp<3) then p:=mSplt(si,sd,sp+1) else p:=-5;
    KartInp(i); Result:=Result+2*max(s,max(h,max(d,p)))*ArKard[i]/NumKar;
  end;
end;

Hosted by uCoz