Lineares RandomRange für Real

[sirius]

Zitat:

Tja, noch war Stochastik nicht dran. Kommt erst in ein paar Monaten.

Na dann! Vorher üben ist immer gut :thumb:

[Alexander Roth]

Zitat:

Zitat von sirius

Zitat:

Tja, noch war Stochastik nicht dran. Kommt erst in ein paar Monaten.

Na dann! Vorher üben ist immer gut :thumb:

Jo. :thumb:

Also ich habe jetzt den kompletten Code umgeschrieben und hier kommt er:

Real Randomzahlen mit ein paar optionen

Delphi-Quellcode:

{-----------------------------------------------------------------------------
  Description:
  Procedure:    RandomRRange
  Arguments:    min,max:real; IncludeMin:boolean=true; IncludeMax:boolean=true
  Result:       real
  Detailed description:
-----------------------------------------------------------------------------}
function RandomRRange(min,max:real; IncludeMin:boolean=true; IncludeMax:boolean=true):real;
var i:byte;
begin
  result:=min;
  i:=0;
  repeat
    inc(i);
    result:=(random*1.1)*(max-min)+min;
  until IsInRange(result,min,max,true,IncludeMin,IncludeMax) or (i>=200);
end;

Ach so dazu bracht man auch IsInRange

Delphi-Quellcode:

{-----------------------------------------------------------------------------
  Description:
  Procedure:    IsInRange
  Arguments:    value,min,max:extended; swapIfNeed:boolean=true; IncludeMin:boolean=true; IncludeMax:boolean=true
  Result:       boolean
  Detailed description:
-----------------------------------------------------------------------------}
function  IsInRange(value,min,max:extended; swapIfNeed:boolean=true; IncludeMin:boolean=true; IncludeMax:boolean=true):boolean;
var temp:extended;
begin
  if swapIfNeed and (min>max) then
    begin
    temp:=max;
    max:=min;
    min:=temp;
    end;


  result:= (value>=min)and(value<=max);
  if not IncludeMin and  (value=min ) then
    result:= false;
  if not IncludeMax and  (value=max ) then
    result:= false;
end;

So jetzt kommt der wichtige Code:

Delphi-Quellcode:

{-----------------------------------------------------------------------------
  Description:
  Procedure:    RandomRRangeSpecial
  Arguments:    min,max:real; IncreaseProbability, DecreaseProbability:boolean; IncludeMin:boolean=true; IncludeMax:boolean=true
  Result:       real
  Detailed description:  Falls IncreaseProbability dann kommen die größeren Zahlen linear häufiger vor als die kleineren
                         Falls DecreaseProbability dann kommen die kleineren Zahlen linear häufiger vor als die größeren
                         Falls beide, dann kommen die mittlere Zahlen linear häufiger vor als die größeren und kleineren
-----------------------------------------------------------------------------}
function RandomRRangeSpecial(min,max:real; IncreaseProbability, DecreaseProbability:boolean; IncludeMin:boolean=true; IncludeMax:boolean=true):real;
begin
  if IncreaseProbability and DecreaseProbability then
    begin
    if randombool then
      result:=RandomRRangeSpecial(min,max/2,true,false,IncludeMin,IncludeMax)  //links
    else
      result:=RandomRRangeSpecial(min+(max-min)/2,max,false,true,IncludeMin,IncludeMax);    //rechts
    end
  else
    begin
    result:=RandomRRange(0,1,IncludeMin,IncludeMax);

    if IncreaseProbability and not DecreaseProbability then
      result:=sign(result)*sqrt(abs(result));

    if not IncreaseProbability and DecreaseProbability then
      result:=1- sign(result)*sqrt(abs(result));

    result:=result*(max-min)+min;
    end;
end;

Sooo.. dann noch die Test Routine:

Delphi-Quellcode:

procedure test(IncreaseProbability, DecreaseProbability, IncludeMin,IncludeMax:boolean);
const path='neu';
var s:string;
    i:integer;
    zufall:real;

    ar: array[0..10] of integer;
begin
  s:='';
  if IncreaseProbability then
    s:=s+'Aufsteigend';
  if IncreaseProbability and DecreaseProbability then
    s:=s+' und ';
  if DecreaseProbability then
    s:=s+'Absteigend';
  s:=s+#13;

  if IncludeMin then
    s:=s+'Mit Min'
  else
    s:=s+'Ohne Min';
  if BoolGleich(IncludeMin, IncludeMax) then
    s:=s+' und ';
  if IncludeMax then
    s:=s+'Mit Max'
  else
    s:=s+'Ohne Max';
  s:=s+#13;


  FillChar(ar,sizeof(ar),0);


  for i:=0 to 1100000 do
    begin
    zufall:=RandomRRangeSpecial(0,10,IncreaseProbability,DecreaseProbability,IncludeMin,IncludeMax);
    inc(ar[trunc(zufall)]);
    end;

  for i:=0 to length(ar)-1 do
    s:=s+inttostr(i)+';'+inttostr(ar[i])+#13+#10;

  intxtschreiben(s,extractfilepath(paramstr(0))+path,'.csv',false);
end;

Für die Test Routine braucht man auch:

Delphi-Quellcode:

{-----------------------------------------------------------------------------
  Description:  Schreibt in eine TXT rein
  Procedure:    intxtschreiben
  Arguments:    text:string; pfad:string=''; vorherloschen:boolean=true
  Result:       None
  Detailed description:
-----------------------------------------------------------------------------}
procedure intxtschreiben(text:string;  pfad:string='';  const endung:string='.txt'; vorherloschen:boolean=true);
var txt:textfile;
begin
  if  pfad='' then
//    pfad:=ExtractFilePath(Application.ExeName)+dateToStr(now)+'  '+inttostr(hourof(now))+' Uhr und '+inttostr(minuteof(now))+' Minuten'+endung
    pfad:=ExtractFilePath(Application.ExeName)+dateToStr(now)+'  '+inttostr(hourof(now))+'h '+inttostr(minuteof(now))+'m '+inttostr(secondof(now))+'s '+endung
  else
    DelDubbleExtension(pfad,endung);

  try
    assignfile(txt,pfad);
    if (fileexists(pfad))and(not vorherloschen) then append(txt) else rewrite(txt);
    writeln(txt,text);
    closefile(txt);
  except
    showmessage('Fehler');
  end;
end;

Und zu guter letzt alles ein bisschen durchprobieren:

Delphi-Quellcode:

  test(false,false,true,true);
  test(false,false,false,false);

  test(true,false,true,true);
  test(false,true,true,true);
  test(true,true,true,true);

randomize natürlich nicht in oncreate vergessen und fertig ist die lineare Zufallsverteilung.

Danke an alle, die mir hier geholfen haben.

Tschüss

Alexander :hi: