unit MultiTest;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Math, Menus, ExtCtrls, jpeg;

type
  TFrmMultiTest = class(TForm)
    TxtAlpha: TEdit;
    LblAlpha: TLabel;
    TxtNmbTest: TEdit;
    LblNmbTest: TLabel;
    Lblkfix: TLabel;
    Txtkfix: TEdit;
    LblkWarn: TLabel;
    LblOr: TLabel;
    Lbla1fix: TLabel;
    Txta1fix: TEdit;
    LblPrecis: TLabel;
    TxtPrecis: TEdit;
    LblPrec2: TLabel;
    BtnGo: TButton;
    BtnExit: TButton;
    Help: TMainMenu;
    AboutMultiTest1: TMenuItem;
    GrpRdBtnak: TRadioGroup;
    RdBtnk: TRadioButton;
    RdBtnalpha: TRadioButton;
    OpenDialog1: TOpenDialog;
    GroupBox1: TGroupBox;
    LblOutputFile: TLabel;
    TxtNameFile: TEdit;
    BtnOutputFileName: TButton;
    CNRSLogo: TImage;
    IRDLogo: TImage;
    Image1: TImage;
    Label1: TLabel;
    procedure TxtAlphaExit(Sender: TObject);
    procedure TxtNmbTestExit(Sender: TObject);
    procedure TxtkfixExit(Sender: TObject);
    procedure Txta1fixExit(Sender: TObject);
    procedure TxtPrecisExit(Sender: TObject);
    procedure BtnGoClick(Sender: TObject);
    procedure BtnExitClick(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure AboutMultiTest1Click(Sender: TObject);
    procedure RdBtnkClick(Sender: TObject);
    procedure RdBtnalphaClick(Sender: TObject);
    procedure BtnOutputFileNameClick(Sender: TObject);
    

  private
    { Déclarations privées }
  public
    { Déclarations publiques }
  end;

var
  FrmMultiTest: TFrmMultiTest;
  alpha, a1fix: real; (*Seuil et seuil partiel*)
  n: integer; (*Nombre de tests*)
  kfix: integer; (*Nombre de tests partiels significatifs au seuil alpha'*)
  da: real; (*précision de alpha'*)
  kopt: integer; (*nombre optimal de tests significatifs*)
  a1opt: real; (*seuil optimal pour detecter le signal dans n tests*)
  k, k1, k2: integer; (*pour calcul de kopt*)
  na11, na12: integer; (*pour calcul de a1opt*)
  a1, an, cni, dn, dmin: real; (*intermédiaires*)
  File1: Text; (*fichier de sortie *)
  Outfin: String; (* nom du fichier de sortie*)



implementation

{$R *.DFM}

procedure TFrmMultiTest.TxtAlphaExit(Sender: TObject);

Var OK: Boolean;

begin

  OK := True;
  Try
    alpha:=StrToFloat(TxtAlpha.text);
  Except
    alpha := 0.05;
    OK := False
  end;
  if (alpha < 0.0) then begin
    alpha := 0.0;
    OK := False;
  end;
  if (alpha > 1.0) then begin
    alpha := 0.05;
    OK := False;
  end;
  txtAlpha.text := FloatToStr(alpha);
  if not OK then
  begin
       ShowMessage('alpha out of Range');
       FrmMultiTest.Show;
       txtAlpha.setFocus;
  end;

end;

procedure TFrmMultiTest.TxtNmbTestExit(Sender: TObject);

Var OK : Boolean;

begin

  OK := True;
  Try
    n:=Trunc(StrToFloat(TxtNmbTest.text));
  Except
    n := 2;
    OK := False
  end;
  if (n < 2) then begin
    n := 2;
    OK := False;
  end;

  txtNmbTest.text := IntToStr(n);
  if not OK then
  begin
       ShowMessage('n out of Range');
       FrmMultiTest.Show;
       txtNmbTest.setFocus;
  end;

  if not (RdBtnalpha.Checked=true) then Txtkfix.text := IntToStr(Trunc(n/2));

end;

procedure TFrmMultiTest.TxtkfixExit(Sender: TObject);

Var OK: Boolean;
    zeroa: real;

begin

    OK := True;
  Try
    kfix:=Trunc(StrToFloat(Txtkfix.text));
  Except
    kfix := trunc(n/2);
    OK := False
  end;
  if (kfix < 0) then begin
    kfix := trunc(n/2);
    OK := False;
  end;

  txtkfix.text := IntToStr(kfix);
  if not OK then
  begin
       ShowMessage('k out of Range');
       FrmMultiTest.Show;
       txtkfix.setFocus;
  end;

  if kfix>0 then
  begin
       Zeroa:=0;
       Txta1fix.text:=FloatToStr(Zeroa);
  end;
  
end;

procedure TFrmMultiTest.Txta1fixExit(Sender: TObject);

Var OK: Boolean;
    Zerok: Integer;

begin

  OK := True;
  Try
    a1fix:=StrToFloat(Txta1fix.text);
  Except
    a1fix := 0;
    OK := False
  end;
  if (a1fix < 0.0) then begin
    a1fix := 0.0;
    OK := False;
  end;
  if (a1fix > 1.0) then begin
    a1fix := 0.05;
    OK := False;
  end;
  txta1fix.text := FloatToStr(a1fix);
  if not OK then
  begin
       ShowMessage('alpha" out of Range');
       FrmMultiTest.Show;
       txta1fix.setFocus;
  end;

  if a1fix>0 then
  begin
       Zerok:=0;
       Txtkfix.text:=IntToStr(Zerok);
  end;

end;

procedure TFrmMultiTest.TxtPrecisExit(Sender: TObject);

Var OK: Boolean;

begin

  OK := True;
  Try
    da:=StrToFloat(TxtPrecis.text);
  Except
    da := 0.001;
    OK := False
  end;
  if (da < 0.0) then begin
    da := 0.001;
    OK := False;
  end;
  if (da > 0.01) then begin
    da := 0.001;
    OK := False;
  end;
  txtPrecis.text := FloatToStr(da);
  if not OK then
  begin
       ShowMessage('Precision out of Range');
       FrmMultiTest.Show;
       txtPrecis.setFocus;
  end;

end;

procedure TFrmMultiTest.BtnGoClick(Sender: TObject);

var kk, na1, i, j: integer;

begin

     alpha:= StrToFloat(TxtAlpha.text);
     n:=Trunc(StrToFloat(TxtNmbTest.text));
     kfix:=Trunc(StrToFloat(Txtkfix.text));
     a1fix:=StrToFloat(Txta1fix.text);
     da:=StrToFloat(TxtPrecis.text);

     kopt:=0;
     a1opt:=0;
     dmin:=1;

     if (kfix = 0) then
     begin
          k1:=1;
          k2:=n;
     end
     else
     begin
          k1:=kfix;
          k2:=kfix;
     end;

     if a1fix=0 then
     begin
          na11:=1;
          na12:=trunc(0.5/da);
     end
     else
     begin
          na11:=trunc(a1fix/da);
          na12:=trunc(a1fix/da);
     end;

     for kk:=k1 to k2 do
     for na1:=na11 to na12 do
     begin
             k:=k1+k2-kk;
             a1:=da*na1;
             an:=0;
             for i:=k to n do
             begin
                 cni:=1;
                 for j:=1 to i do cni:=cni*(n-j+1)/j;
                 an:=an+cni*(power(a1, i))*(power((1-a1), (n-i)));
             end;
             dn:=alpha-an;
             if ((dn>0) and (dn<=dmin)) then
             begin
                  kopt:=k;
                  a1opt:=a1;
                  dmin:=dn;
             end;
     end;

     Append(file1);
     write(file1, alpha:8:6,#9, n,#9, kfix,#9, a1fix:8:6,#9, da:8:6,#9);
     writeln(file1, a1opt:8:6,#9,kopt);
     CloseFile(File1);

     ShowMessage('    Optimal k is: '+IntToStr(kopt)+#10+#10+
                 'Optimal alpha is: '+FloatToStr(a1opt));

    RdBtnk.Checked:=false;
    RdBtnalpha.Checked:=false;             
    Txta1fix.Enabled:=false;
    TxtKfix.Enabled:=false;

end;



procedure TFrmMultiTest.BtnExitClick(Sender: TObject);
begin
     ShowMessage('Bye, thank you for using MultiTest');
     Application.Terminate;
end;

procedure TFrmMultiTest.FormActivate(Sender: TObject);
begin
  Outfin:=TxtNameFile.Text;
  AssignFile(file1, OutFin);
  If FileExists(Outfin) then
        begin
             reset(file1);
             CloseFile(file1);
        end else
        Begin
          rewrite(file1);
          CloseFile(file1);
          append(file1); (*final file*)
          write(file1,'Alpha',#9,'n',#9,'k',#9,'alpha"',#9,'Precision',#9);
          writeln(file1,'alphaOpt',#9,'kOpt');
          CloseFile(File1);
        end;
  alpha:=0.05;
  n:=2;
  kfix:=1;
  a1fix:=0;
  da:=0.0001;
  Txta1fix.Enabled:=false;
  TxtKfix.Enabled:=false;
end;

procedure TFrmMultiTest.AboutMultiTest1Click(Sender: TObject);
begin
ShowMessage
('            MultiTest V.1.2, January 2009,'+#10+#10+
'    A program to binomially combine independent tests.'+#10+#10+
'    Algorithm written in Basic by Anatoly T. Teriokhin'+#10+
'       Section of General Ecology, Dept. of Biology,'+#10+
' Moscow Lomonosov State University, Moscow 119899, Russia'+#10+
'                  terekhin_a@mail.ru'+#10+#10+
'          Written in Delphi by Thierry de Meeûs'+#10+
'     DR2 CNRS, UMR 177 IRD/CIRAD, TA A-17/G, CIRDES'+#10+
'       01 BP 454, Bobo-Dioulasso 01, Burkina-Faso'+#10+
'                  demeeus@mpl.ird.fr');
end;

procedure TFrmMultiTest.RdBtnkClick(Sender: TObject);
begin
     a1fix:=0;
     kfix:=Trunc(n/2);
     Txtkfix.Text:=IntToStr(kfix);
     Txta1fix.Enabled:=false;
     Txta1fix.Text:=FloatToStr(a1fix);
     TxtKfix.Enabled:=true;
end;

procedure TFrmMultiTest.RdBtnalphaClick(Sender: TObject);
begin
     kfix:=0;
     a1fix:=0.05;
     Txta1fix.Text:=FloatToStr(a1fix);
     TxtKfix.Enabled:=false;
     Txtkfix.Text:=IntToStr(kfix);
     Txta1fix.Enabled:=true;
end;

procedure TFrmMultiTest.BtnOutputFileNameClick(Sender: TObject);
begin
     OpenDialog1.Execute;
     if OpenDialog1.FileName ='' then begin
     TxtNameFile.Text := 'Results.mul';
     end else begin
     TxtNameFile.Text := OpenDialog1.FileName;
     OutFin := OpenDialog1.FileName;
     AssignFile(file1,OutFin);
     if FileExists(OutFin) then
        begin
             reset(file1);
             CloseFile(file1);
        end else
        Begin
             rewrite(file1);
             CloseFile(file1);
             append(file1);
             write(file1,'Alpha',#9,'k',#9,'k"',#9,'alpha"',#9,'Precision',#9);
             writeln(file1,'alphaOpt',#9,'kOpt');
             CloseFile(File1);
        end;
     end;
end;

end.