カールソンの楕円積分(複素数)

 カールソンの楕円積分を複素数で計算するプログラムです。
楕円積憤は、RC、RD、RF、RJの積分が必要ですが、RDRJで代用出来るので、RC、RF、RJの三個について検討します。
 RCは、RFで代用可能ですが、RJの計算時、積分ループから多くの回数呼び出されますので、計算時間短縮の為、専用のルーチンとします。
これが一般的な様です。

 複素数での楕円積分は、実務で計算する事が少ないのか、インターネットで検索しても、複素数の計算例やプログラムはあまり存在しません。
そこで、arXiv.org から Numerical computation of real or complex elliptic integralspdfをダウンロードしてプログラムの作成資料としました。

 資料には、プログラム自体はありません、計算方法と、計算式のみです。
以前に作成した、実数のプログラムを、資料の内容にあわせて変更しました。
資料には、複素数引数と、計算結果が記載されていたので、RC,RF,RJのプログラム作成と同時に、答え合わせが出来るプログラムを作成してデバックを容易にしました。
 資料には、小数点以下15桁目を四捨五入した値が記されており、doubleの精度で計算した場合とは最終桁辺り差が出ます。
doubleの精度は17桁程度しかなく、長い計算では、15桁辺りでも誤差がでます。


 計算方法については、前記リンクからPDFをダウンロードして参照して下さい。
最初のプログラムは、delphi の 複素数 VariantComplexを使用したプログラムです。
小数点以下の値の計算精度あまり良くないのですが、四則演算、関数が普通の計算として出来るのでプログラムの確認が容易に出来ます。
これで、確認がとれたら、多倍長に変換します。

RC,RF,RJ計算とチェックプログラム

//
// プログラムは https://arxiv.org/abs/math/9409227 のレポートを元に作成しています

unit Main;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls, Vcl.Buttons;

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    RJtest1: TBitBtn;
    Rjdtxr: TEdit;
    Rjdtyr: TEdit;
    Rjdtzr: TEdit;
    Rjdtpr: TEdit;
    Rjansr: TEdit;
    Rjansi: TEdit;
    Rjclc0: TEdit;
    Rjclc1: TEdit;
    RjRadio: TRadioGroup;
    Rjdtxi: TEdit;
    Rjdtyi: TEdit;
    Rjdtzi: TEdit;
    Rjdtpi: TEdit;
    Rjtest2: TBitBtn;
    Rftest1: TBitBtn;
    Rftest2: TBitBtn;
    Rctest1: TBitBtn;
    Rctest2: TBitBtn;
    Rfdtxr: TEdit;
    Rfdtxi: TEdit;
    Rfdtyr: TEdit;
    Rfdtyi: TEdit;
    Rfdtzr: TEdit;
    Rfdtzi: TEdit;
    Rfansr: TEdit;
    Rfansi: TEdit;
    Rfclc0: TEdit;
    Rfclc1: TEdit;
    RfRadio: TRadioGroup;
    Rcdtxr: TEdit;
    Rcdtxi: TEdit;
    Rcdtyr: TEdit;
    Rcdtyi: TEdit;
    Rcclc0: TEdit;
    Rcclc1: TEdit;
    Rcansi: TEdit;
    Rcansr: TEdit;
    RcRadio: TRadioGroup;
    procedure RJtest1Click(Sender: TObject);
    procedure Rjtest2Click(Sender: TObject);
    procedure Rftest1Click(Sender: TObject);
    procedure Rftest2Click(Sender: TObject);
    procedure Rctest1Click(Sender: TObject);
    procedure Rctest2Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

uses system.Math, System.VarCmplx;

// 複素数の生成
[ delphiのcomplexにないのでdoubleからcomplexに変換するルーチンの追加です}
function Varcomplex(a, b: double): Variant;
begin
  result := varascomplex(result);
  result.real := a;
  result.Imaginary := b;
end;

// RCの計算
[引数yがゼロの場合は計算出来ません]
function RCC(x, y: variant): variant;
label
  Ext;
const
  r  = 1E-24;              {収束判定値設定用 資料では r<10^-4 となっていますが、15桁の精度が必要な場合10^-24程度となります}
  c1 = 3 / 10;             {c1~c6は誤差補正用の定数です}
  c2 = 1 / 7;
  c3 = 3 / 8;
  c4 = 9 / 22;
  c5 = 159 / 208;
  c6 = 9 / 8;
var
  xt, yt, w, yb : variant;
  lamda, A0, Q  : variant;
  s, Am         : variant;
  m             : integer;
begin
  if Varcomplexabs(y) = 0 then begin                    // yがゼロだったら終了処理 
    m := 0;
    result := Varcomplex(0, 0);
    goto Ext;
  end;
  {引数yの実数値がマイナスで虚数値がゼロのの場合、値の変換をして計算します}
  if (y.real > 0) or (y.Imaginary <> 0) then begin
    xt := x;
    yt := y;
    w  := Varcomplex(1, 0);
  end
  else begin
    xt := x - y;
    yt := - y;
    w := Varcomplexsqrt(x / xt);
  end;
  yb := yt;
  A0 := (xt + yt + yt) / 3;
  Am := A0;
  {計算収束判定値Qの値は実数となります}
  Q := 1 / power(3 * r, 1 / 8) * Varcomplexabs(A0 - xt);
  m := 0;
  repeat
    lamda := 2 * Varcomplexsqrt(xt) * Varcomplexsqrt(yt) + yt;
    xt := (xt + lamda) / 4;
    yt := (yt + lamda) / 4;
    Am := (Am + lamda) / 4;
    m := m + 1;
  until power(4, -m) * Q < Varcomplexabs(Am);
  {誤差部分の係数s計算}
 s := (yb - A0) / power(4, m) / Am;
  {誤差係数sによる値を加算}
  result := w * (1 + s * s * (c1 + s * (c2 + s * (c3 + s * (c4 + s * (c5 + s * c6)))))) / Varcomplexsqrt(Am);
Ext:
  {デバッグの為の表示です 本来は不要です}
  Form1.Memo1.Lines.Append('RC Loop数 = ' + intTostr(m));
end;

// RFの計算
[引数にゼロが二つある場合は計算出来ません]
function RFC(x, y, z: variant): variant;
label
  Ext;
const
  r = 1E-24;                {収束判定値設定用 資料では r<10^-4 となっていますが、15桁の精度が必要な場合10^-24程度となります}
  c1 = 1 / 10;              {c1~c4は誤差補正用の定数です}
  c2 = 1 / 14;
  c3 = 1 / 24;
  c4 = 3 / 44;
var
  one             : variant;
  lamda           : variant;
  xm, ym, zm      : variant;
  A0, Am, Q       : variant;
  sqrtx, sqrty, sqrtz  : variant;
  m               : integer;
  X0, Y0, Z0      : variant;
  E2, E3          : variant;
begin
  {値がゼロの引数カウント}
  m := 0;
  if Varcomplexabs(x) = 0 then inc(m);
  if Varcomplexabs(y) = 0 then inc(m);
  if Varcomplexabs(z) = 0 then inc(m);
  if m > 1 then begin                                   // ゼロが二個有ったら終了
    m := 0;
    result := Varcomplex(0, 0);
    goto Ext;
  end;

  one := Varcomplex(1, 0);
  xm := x;
  ym := y;
  zm := z;
  A0 := (xm + ym + zm) / 3;
  Am := A0;
  {計算収束判定値Qの値は実数となります}
  Q := power(3 * r, -1 / 6) * max(Varcomplexabs(A0 - xm),
                              max(Varcomplexabs(A0 - ym), Varcomplexabs(A0 - zm)));
  m := 0;
  repeat
    sqrtx := Varcomplexsqrt(xm);
    sqrty := Varcomplexsqrt(ym);
    sqrtz := Varcomplexsqrt(zm);
    lamda := sqrtx * (sqrty  + sqrtz) + sqrty * sqrtz;
    xm := (xm + lamda) / 4;
    ym := (ym + lamda) / 4;
    zm := (zm + lamda) / 4;
    Am := (Am + lamda) / 4;
    m := m + 1;
  until power(4, -m) * Q < Varcomplexabs(Am);
  {誤差補正係数の計算} 
  X0 := (A0 - x) / power(4, m) / Am;
  Y0 := (A0 - y) / power(4, m) / Am;
  Z0 := -X0 - Y0;
  E2 := X0 * Y0 - Z0 * Z0;
  E3 := X0 * Y0 * Z0;
 {誤差部分の補正を追加して計算}
  result := VarcomplexPower(Am, -1 / 2) * (one - c1 * E2 + c2 * E3 + c3 * E2 * E2
                                           - c4 * E2 * E3);
Ext:
  {デバッグの為の表示です 本来は不要です}
  Form1.Memo1.Lines.Append('RF Loop数 = ' + intTostr(m));
end;

// RJの計算
[引数にゼロが二つある場合は計算出来ません]
function RJC(x, y, z, p: variant): variant;
label
  Ext;
const
  r = 1E-24;      {収束判定値設定用 資料では r<10^-4 となっていますが、15桁の精度が必要な場合10^-24程度となります}
var
  one                     : variant;
  rj, xt, yt, zt, pt      : variant;
  sum, a, b, rho, A0      : variant;
  tau, rcx, lamda, Q , m, Am     : variant;
  sqrtx, sqrty, sqrtz, sqrtp, dm, em : variant;
  delta : variant;
  c1, c2, c3, c4, c5, c6  : variant;
  test                    : integer;
  X0, Y0, Z0, P0          : variant;
  E2, E3, E4, E5          : variant;
begin
  {値がゼロの引数カウント}
  m := 0;
  if Varcomplexabs(x) = 0 then inc(m);
  if Varcomplexabs(y) = 0 then inc(m);
  if Varcomplexabs(z) = 0 then inc(m);
  if Varcomplexabs(p) = 0 then inc(m);
  if m > 1 then begin                                   // ゼロが二個有ったら終了
    m := 0;
    result := Varcomplex(0, 0);
    goto Ext;
  end;

  c1 := 3 / 14;          {c1~c6は誤差補正用の定数です}
  c2 := 1 / 6;
  c3 := 9 / 88;
  c4 := 3 / 22;
  c5 := 9 / 52;
  c6 := 3 / 26;
  sum := Varcomplex(0, 0);  {RC計算の合計値ゼロ設定}
  one := Varcomplex(1, 0);
  {pの実数部がマイナスでyの実数部がプラスの場合計算方法を変更します}
  {複素数なので、虚数部がゼロでない限り符号は無いのですが、演算結果が違った場合は虚数部の条件も追加します}
  if (p.real <= 0) and (y.real > 0) then test := -1
                                    else test := 1;
  if test > 0 then begin
    xt := x;
    yt := y;
    zt := z;
    pt := p;
    a  := Varcomplex(0, 0);
    b  := Varcomplex(0, 0);
    rcx := Varcomplex(0, 0);
  end
  else begin
    {xt,yt,ztを小さい方から大きい方への順場に並べ替えます}
    {最小値の検索minは、複素数に対応していないので、問題が有ったら変更します}
  xt := Varcomplex(min(x, min(y, z)), 0);
    {最大値の検索maxは、複素数に対応していないので、問題が有ったら変更します}
    zt := Varcomplex(max(x, max(y, z)), 0);
    yt := x + y + z - xt - zt;
    a :=  VarComplexInverse(yt - p);   {a = 1/(yt-p)}
    b := a * (zt - yt) * (yt - xt);
    pt := yt + b;
    rho := xt * zt / yt;
    tau := p * pt / yt;
    rcx := rcc(rho, tau);
  end;
  A0 := (xt + yt + zt + pt + pt) / 5;
  AM := A0;
  delta := (pt - xt) * (pt - yt) * (pt - zt);
  {計算収束判定値Qの値は実数となります}
  Q := power(r / 4, -1 / 6) * max(Varcomplexabs(A0 - xt), max(Varcomplexabs(A0 - yt),
                                            max(Varcomplexabs(A0 - zt), Varcomplexabs(A0 - pt))));
  m := 0;
  repeat
    sqrtx := Varcomplexsqrt(xt);
    sqrty := Varcomplexsqrt(yt);
    sqrtz := Varcomplexsqrt(zt);
    sqrtp := Varcomplexsqrt(pt);
    lamda := sqrtx * (sqrty + sqrtz) + sqrty * sqrtz;
    dm := (sqrtp + sqrtx) * (sqrtp + sqrty) * (sqrtp + sqrtz);
    em := Varcomplexpower(4, -3 * m) * delta / dm / dm;
    sum := sum + power(4, -m) / dm * Rcc(one, one + em);      {∑4^-m /dm Rc(1,1+em)}
    Am    := (Am + lamda) / 4;
    xt    := (xt + lamda) / 4;
    yt    := (yt + lamda) / 4;
    zt    := (zt + lamda) / 4;
    pt    := (pt + lamda) / 4;
    m := m + 1;
  until power(4, - m) * Q < Varcomplexabs(Am);
  {誤差補正係数の計算} 
  X0 := (A0 - x) / power(4, m) / Am;
  Y0 := (A0 - y) / power(4, m) / Am;
  Z0 := (A0 - z) / power(4, m) / Am;
  P0 := (-X0 - Y0 - Z0) / 2;
  E2 := X0 * Y0 + X0 * Z0 + Y0 * Z0 - 3 * P0 * P0;
  E3 := X0 * Y0 * Z0 + 2 * E2 * P0 + 4 * P0 * P0 * P0;
  E4 := (2 * X0 * Y0 * Z0 + E2 * P0 + 3 * P0 * P0 * P0) / P0;
  E5 := X0 * Y0 * Z0 * P0 * P0;
 {誤差部分の補正を追加して計算}
  rj := Varcomplexpower(4, -m) * Varcomplexpower(Am, -3 / 2) * (one - c1 * E2 + c2 * E3 + c3 * E2 * E2
                      - c4 * E4 - c5 * E2 * E3 + c6 * E5) + 6 * sum;
 {計算を変更した場合の計算追加}
  if test < 0 then
    rj := a * (b * rj + 3 * (rcx - rfc(xt, yt, zt)));
  result := rj;
  {デバッグの為の表示です 本来は不要です}
  form1.Canvas.TextOut(250,320,'             ');
  form1.Canvas.TextOut(250,320,'rj 判定 ' + floatTostr(test));

Ext:
  {デバッグの為の表示です 本来は不要です}
  Form1.Memo1.Lines.Append('RJ Loop数 = ' + intTostr(m));
end;


// 複素数の生成
{function Varcomplex(a, b:variant):bariant と同じですが、このまま使用します}
function Vc(a, b: double): Variant;
begin
  result := varascomplex(result);
  result.real := a;
  result.Imaginary := b;
end;

{RC 計算確認用データ}
var
  rcdt : array[0..5] of array[0..1] of variant;
  rcan : array[0..5] of array[0..1] of double;

procedure datasetRc;
begin
  rcdt[0,0] := Vc( 0, 0);   rcdt[0, 1] := Vc(1/4, 0);
  rcdt[1,0] := Vc(9/4, 0);  rcdt[1, 1] := Vc(2, 0);
  rcdt[2,0] := Vc( 0, 0);   rcdt[2, 1] := Vc(0, 1);
  rcdt[3,0] := Vc( 0,-1);   rcdt[3, 1] := Vc(0, 1);
  rcdt[4,0] := Vc(1/4, 0);  rcdt[4, 1] := Vc(-2, 0);
  rcdt[5,0] := Vc( 0, 1);   rcdt[5, 1] := Vc(-1, 0);

  rcan[0,0] := 3.1415926535898;   rcan[0,1] := 0;
  rcan[1,0] := 0.69314718055995;  rcan[1,1] := 0;
  rcan[2,0] := 1.1107207345396;   rcan[2,1] := -1.1107207345396;
  rcan[3,0] := 1.2260849569072;   rcan[3,1] := -0.34471136988768;
  rcan[4,0] := 0.23104906018665;  rcan[4,1] := 0;
  rcan[5,0] := 0.77778596920447;  rcan[5,1] := 0.19832484993429;
end;

{RF 計算確認用データ}
var
  rfdt : array[0..5] of array[0..2] of variant;
  rfan : array[0..5] of array[0..1] of double;

procedure datasetRf;
begin
  rfdt[0,0] := Vc( 1, 0); rfdt[0,1] := Vc( 2, 0); rfdt[0,2] := Vc( 0, 0);
  rfdt[1,0] := Vc( 0, 1); rfdt[1,1] := Vc( 0,-1); rfdt[1,2] := Vc( 0, 0);
  rfdt[2,0] := Vc(-1, 1); rfdt[2,1] := Vc( 0, 1); rfdt[2,2] := Vc( 0, 0);
  rfdt[3,0] := Vc( 2, 0); rfdt[3,1] := Vc( 3, 0); rfdt[3,2] := Vc( 4, 0);
  rfdt[4,0] := Vc( 0, 1); rfdt[4,1] := Vc( 0,-1); rfdt[4,2] := Vc( 2, 0);
  rfdt[5,0] := Vc(-1, 1); rfdt[5,1] := Vc( 0, 1); rfdt[5,2] := Vc( 1,-1);

  rfan[0,0] := 1.3110287771461;  rfan[0,1] := 0;
  rfan[1,0] := 1.8540746773014;  rfan[1,1] := 1.8540746773014;
  rfan[2,0] := 0.79612586584234; rfan[2,1] := -1.2138566698365;
  rfan[3,0] := 0.58408284167715; rfan[3,1] := 0;
  rfan[4,0] := 1.0441445654064;  rfan[4,1] := 0;
  rfan[5,0] := 0.93912050218619; rfan[5,1] := -0.53296252018635;
end;

{RJ 計算確認用データ}
var
  rjdt : array[0..9] of array[0..3] of variant;
  rjan : array[0..9] of array[0..1] of double;

procedure datasetRj;
begin
  rjdt[0,0] := Vc( 0, 0); rjdt[0,1] := Vc( 1, 0); rjdt[0,2] := Vc( 2, 0); rjdt[0,3] := Vc( 3, 0);
  rjdt[1,0] := Vc( 2, 0); rjdt[1,1] := Vc( 3, 0); rjdt[1,2] := Vc( 4, 0); rjdt[1,3] := Vc( 5, 0);
  rjdt[2,0] := Vc( 2, 0); rjdt[2,1] := Vc( 3, 0); rjdt[2,2] := Vc( 4, 0); rjdt[2,3] := Vc(-1, 1);
  rjdt[3,0] := Vc( 0, 1); rjdt[3,1] := Vc( 0,-1); rjdt[3,2] := Vc( 0, 0); rjdt[3,3] := Vc( 2, 0);
  rjdt[4,0] := Vc(-1, 1); rjdt[4,1] := Vc(-1,-1); rjdt[4,2] := Vc( 1, 0); rjdt[4,3] := Vc( 2, 0);
  rjdt[5,0] := Vc( 0, 1); rjdt[5,1] := Vc( 0,-1); rjdt[5,2] := Vc( 0, 0); rjdt[5,3] := Vc( 1,-1);
  rjdt[6,0] := Vc(-1, 1); rjdt[6,1] := Vc(-1,-1); rjdt[6,2] := Vc( 1, 0); rjdt[6,3] := Vc(-3, 1);
  rjdt[7,0] := Vc(-1, 1); rjdt[7,1] := Vc(-2,-1); rjdt[7,2] := Vc( 0,-1); rjdt[7,3] := Vc(-1, 1);
  rjdt[8,0] := Vc( 2, 0); rjdt[8,1] := Vc( 3, 0); rjdt[8,2] := Vc( 4, 0); rjdt[8,3] := Vc(-0.5, 0);
  rjdt[9,0] := Vc( 2, 0); rjdt[9,1] := Vc( 3, 0); rjdt[9,2] := Vc( 4, 0); rjdt[9,3] := Vc(-5, 0);

  rjan[0,0] :=  0.77688623778582;        rjan[0,1] :=  0;
  rjan[1,0] :=  0.14297579667157;        rjan[1,1] :=  0;
  rjan[2,0] :=  0.13613945827771;        rjan[2,1] := -0.38207561624427;
  rjan[3,0] :=  1.6490011662711;         rjan[3,1] :=  0;
  rjan[4,0] :=  0.94148358841220;        rjan[4,1] :=  0;
  rjan[5,0] :=  1.8260115229009;         rjan[5,1] :=  1.2290661908643;
  rjan[6,0] := -0.61127970812028;        rjan[6,1] := -1.0684038390007;
  rjan[7,0] :=  1.8249027393704;         rjan[7,1] := -1.2218475784827;
  rjan[8,0] :=  0.24723819703052;        rjan[8,1] :=  0;
  rjan[9,0] := -0.12711230042964;        rjan[9,1] :=  0;
end;

{RC テスト計算}
{用意された配列データからラジオボタンで選択計算しま}
procedure TForm1.Rctest1Click(Sender: TObject);
var
  i : integer;
  x, y: variant;
  ans0r, ans0i: double;
  ans       : variant;
begin
  Form1.Memo1.clear;
  datasetRc;
  i := RcRadio.ItemIndex;
  x := rcdt[i,0]; y := rcdt[i,1];
  ans0r := rcan[i,0]; ans0i := rcan[i,1];
  Rcansr.Text := floatTostr(ans0r);
  Rcansi.Text := floatTostr(ans0i);
  ans := RCC(x, y);
  Rcdtxr.Text := floatTostr(x.real); Rcdtxi.Text := floatTostr(x.Imaginary);
  Rcdtyr.Text := floatTostr(y.real); Rcdtyi.Text := floatTostr(y.Imaginary);

  Rcclc0.Text := floatTostr(ans.real); Rcclc1.Text := floatTostr(ans.Imaginary);
end;

{RC テスト任意データ計算}
{入力された値を元に計算します}
pprocedure TForm1.Rctest2Click(Sender: TObject);
var
  dinxr, dinxi: double;
  dinyr, dinyi: double;
  ch: integer;
  x, y: variant;
  ans : variant;
begin
  val(Rcdtxr.Text, dinxr, ch);
  if ch <> 0 then begin
    application.MessageBox('dtxrに間違いがあります。','注意',0);
    exit;
  end;
  val(Rcdtxi.Text, dinxi, ch);
  if ch <> 0 then begin
    application.MessageBox('dtxiに間違いがあります。','注意',0);
    exit;
  end;
  val(Rcdtyr.Text, dinyr, ch);
  if ch <> 0 then begin
    application.MessageBox('dtyrに間違いがあります。','注意',0);
    exit;
  end;
  val(Rcdtyi.Text, dinyi, ch);
  if ch <> 0 then begin
    application.MessageBox('dtyiに間違いがあります。','注意',0);
    exit;
  end;
  memo1.Clear;
  x := Vc( dinxr, dinxi);
  y := Vc( dinyr, dinyi);
  ans := RCC(x, y);
  memo1.Lines.Append(floatTostr(ans.real) + ' ' + floatTostr(ans.Imaginary) + 'i');
end;

{RF テスト計算}
{用意された配列データからラジオボタンで選択計算しま}
procedure TForm1.Rftest1Click(Sender: TObject);
var
  i : integer;
  x, y, z: variant;
  ans0r, ans0i: double;
  ans       : variant;
begin
  Form1.Memo1.clear;
  datasetRf;
  i := RfRadio.ItemIndex;
  x := rfdt[i,0]; y := rfdt[i,1]; z := rfdt[i,2];
  ans0r := rfan[i,0]; ans0i := rfan[i,1];
  Rfansr.Text := floatTostr(ans0r);
  Rfansi.Text := floatTostr(ans0i);
  ans := RFC(x, y, z);
  Rfdtxr.Text := floatTostr(x.real); Rfdtxi.Text := floatTostr(x.Imaginary);
  Rfdtyr.Text := floatTostr(y.real); Rfdtyi.Text := floatTostr(y.Imaginary);
  Rfdtzr.Text := floatTostr(z.real); Rfdtzi.Text := floatTostr(z.Imaginary);

  Rfclc0.Text := floatTostr(ans.real); Rfclc1.Text := floatTostr(ans.Imaginary);
end;

{RF テスト任意データ計算}
{入力された値を元に計算します}
procedure TForm1.Rftest2Click(Sender: TObject);
var
  dinxr, dinxi: double;
  dinyr, dinyi: double;
  dinzr, dinzi: double;
  ch: integer;
  x, y, z: variant;
  ans : variant;
begin
  val(Rfdtxr.Text, dinxr, ch);
  if ch <> 0 then begin
    application.MessageBox('dtxrに間違いがあります。','注意',0);
    exit;
  end;
  val(Rfdtxi.Text, dinxi, ch);
  if ch <> 0 then begin
    application.MessageBox('dtxiに間違いがあります。','注意',0);
    exit;
  end;
  val(Rfdtyr.Text, dinyr, ch);
  if ch <> 0 then begin
    application.MessageBox('dtyrに間違いがあります。','注意',0);
    exit;
  end;
  val(Rfdtyi.Text, dinyi, ch);
  if ch <> 0 then begin
    application.MessageBox('dtyiに間違いがあります。','注意',0);
    exit;
  end;
  val(Rfdtzr.Text, dinzr, ch);
  if ch <> 0 then begin
    application.MessageBox('dtzrに間違いがあります。','注意',0);
    exit;
  end;
  val(Rfdtzi.Text, dinzi, ch);
  if ch <> 0 then begin
    application.MessageBox('dtziに間違いがあります。','注意',0);
    exit;
  end;
  memo1.Clear;
  x := Vc( dinxr, dinxi);
  y := Vc( dinyr, dinyi);
  z := Vc( dinzr, dinzi);
  ans := RfC(x, y, z);
  memo1.Lines.Append(floatTostr(ans.real) + ' ' + floatTostr(ans.Imaginary) + 'i');
end;

{RJ テスト計算}
{用意された配列データからラジオボタンで選択計算しま}
procedure TForm1.RJtest1Click(Sender: TObject);
var
  i : integer;
  x, y, z, p: variant;
  ans0r, ans0i: double;
  ans       : variant;
begin
  Form1.Memo1.clear;
  datasetRj;
  i := RJRadio.ItemIndex;
  x := rjdt[i,0]; y := rjdt[i,1]; z := rjdt[i,2]; p := rjdt[i, 3];
  ans0r := rjan[i,0]; ans0i := rjan[i,1];
  RJansr.Text := floatTostr(ans0r);
  RJansi.Text := floatTostr(ans0i);
  ans := RJC(x, y, z, p);
  RJdtxr.Text := floatTostr(x.real); RJdtxi.Text := floatTostr(x.Imaginary);
  RJdtyr.Text := floatTostr(y.real); RJdtyi.Text := floatTostr(y.Imaginary);
  RJdtzr.Text := floatTostr(z.real); RJdtzi.Text := floatTostr(z.Imaginary);
  RJdtpr.Text := floatTostr(p.real); RJdtpi.Text := floatTostr(p.Imaginary);

  RJclc0.Text := floatTostr(ans.real); RJclc1.Text := floatTostr(ans.Imaginary);
end;


{RJ テスト任意データ計算}
{入力された値を元に計算します}
procedure TForm1.Rjtest2Click(Sender: TObject);
var
  dinxr, dinxi: double;
  dinyr, dinyi: double;
  dinzr, dinzi: double;
  dinpr, dinpi: double;
  ch: integer;
  x, y, z, p : variant;
  ans : variant;
begin
  val(RJdtxr.Text, dinxr, ch);
  if ch <> 0 then begin
    application.MessageBox('dtxrに間違いがあります。','注意',0);
    exit;
  end;
  val(RJdtxi.Text, dinxi, ch);
  if ch <> 0 then begin
    application.MessageBox('dtxiに間違いがあります。','注意',0);
    exit;
  end;
  val(RJdtyr.Text, dinyr, ch);
  if ch <> 0 then begin
    application.MessageBox('dtyrに間違いがあります。','注意',0);
    exit;
  end;
  val(RJdtyi.Text, dinyi, ch);
  if ch <> 0 then begin
    application.MessageBox('dtyiに間違いがあります。','注意',0);
    exit;
  end;
  val(RJdtzr.Text, dinzr, ch);
  if ch <> 0 then begin
    application.MessageBox('dtzrに間違いがあります。','注意',0);
    exit;
  end;
  val(RJdtzi.Text, dinzi, ch);
  if ch <> 0 then begin
    application.MessageBox('dtziに間違いがあります。','注意',0);
    exit;
  end;
  val(RJdtpr.Text, dinpr, ch);
  if ch <> 0 then begin
    application.MessageBox('dtprに間違いがあります。','注意',0);
    exit;
  end;
  val(RJdtpi.Text, dinpi, ch);
  if ch <> 0 then begin
    application.MessageBox('dtpiに間違いがあります。','注意',0);
    exit;
  end;
  memo1.Clear;
  x := Vc( dinxr, dinxi);
  y := Vc( dinyr, dinyi);
  z := Vc( dinzr, dinzi);
  p := Vc( dinpr, dinpi);
  ans := RJC(x, y, z, p);
  memo1.Lines.Append(floatTostr(ans.real) + ' ' + floatTostr(ans.Imaginary) + 'i');
end;

end.

download RC_RF_RJ_checkVariant.zip


各種プログラム計算例に戻る