組み合わせ。前回の続きです。ごめんなさい。 (ID:16348)

名前

ホームページ(ブログ、Twitterなど)のURL (省略可)

本文

なはっ、乗り遅れてしまった…
以前私が示したのは2通りのみの抽出です。
n通りは凄く難しいんです。
ですが、ウオレスさんが示してくれましたね、スゴイッス。
レスが無いところをみると自分のプログラムに応用できてないと思ったので一応一部改変をしてみました、改悪かな？

(***********************************************************
    組合せの生成
***********************************************************)
function first( n :Longword) :Longword;
begin
  first := ((1  shl  n) - 1);
end;

function nextset(x :Longword ):Longword;
var
    smallest, ripple, new_smallest, ones :Longword ;
begin
    smallest := x and -x;
    ripple   := x + smallest;
    new_smallest := ripple and -ripple;
    ones     := ((new_smallest div smallest)  shr  1) - 1;
    Result   := (ripple or ones) ;
end;

procedure printset(s : Longword; var No: array of integer);
var
  i,p :Integer;
  St:AnsiString;
begin
  St := '';
  p := 0;
  i := 1;
    while( i <= N) do  begin
        if ((s and 1) <> 0 )then
        begin
          //  St := St + Format(' %d', [i]) ;
          No[p]:=i;
          inc(p);
        end;
        s  := s  shr  1;
      Inc(i);
    end;
  //Form1.Memo1.Lines.Add(St);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  Data : array of Double;
  No   : array of Integer;
  Combination : Integer;
  Ans    : Double;
  AnsStr : string;

requiestValue : Double; //期待値
  closestValue  : Double; //それに最も近い値
  closestStr    : String;

i,p    : integer;
  x,dbg  : Longword ;
begin
  Memo1.Clear;
//Memo2に改行区切りデータがあるとする
  SetLength(Data,Memo2.Lines.Count);
  for i:=0 to Length(Data)-1 do
    Data[i]:= StrToFloat(Memo2.Lines[i]);
//Edit1に目的とする値を入れる 45% なら 45
  requiestValue:= StrToFloat(Edit1.Text);

closestValue:=0;
//1通りから4通りまでまとめて計算
for Combination := 1 to 4 do
begin
  SetLength(No,Combination);
  i := 1;
  x := first(Combination);
  dbg := (not first(Length(Data)));
  while(  (x and  dbg ) = 0 )do
  begin
    printset(x,No);
      //計算処理
      Ans:=1;
      AnsStr:='';
      for p:= 0 to Combination-1 do
      begin
        Ans:=Ans * Data[No[p]-1];
        AnsStr :=AnsStr + inttostr(No[p]) + ',';
      end;
      Ans := Ans / 100;
      if Abs(requiestValue - Ans) < Abs(requiestValue - closestValue) then
      begin
        closestValue:= Ans;
        closestStr  := AnsStr + ' =' + Format('%3.2f',[Ans]) + '%';
      end;
      AnsStr := AnsStr + ' =' + Format('%3.2f',[Ans]) + '%';

Memo1.Lines.Add(AnsStr);   //これが無ければもっと高速
      //計算処理ここまで
    x := nextset(x);
    Inc(i);
    dbg := (not first(Length(Data))) ;
  end;
end;
Showmessage(closestStr);
end;

←解決時は質問者本人がここをチェックしてください。

戻る