{Copyright or © or Copr. :

CNRS - Laboratoire Mouvement & Perception
franck.buloup@univmed.fr

This software is a computer program whose purpose is to highly simplify  
the use of ADwinPro realtime systems when you develop experimental
protocols  on life's sciences area.

This software is governed by the CeCILL  license under French law and
abiding by the rules of distribution of free software.  You can  use, 
modify and/ or redistribute the software under the terms of the CeCILL
license as circulated by CEA, CNRS and INRIA at the following URL
"http://www.cecill.info". 

As a counterpart to the access to the source code and  rights to copy,
modify and redistribute granted by the license, users are provided only
with a limited warranty  and the software's author,  the holder of the
economic rights,  and the successive licensors  have only  limited
liability. 

In this respect, the user's attention is drawn to the risks associated
with loading,  using,  modifying and/or developing or reproducing the
software by the user in light of its specific status of free software,
that may mean  that it is complicated to manipulate,  and  that  also
therefore means  that it is reserved for developers  and  experienced
professionals having in-depth computer knowledge. Users are therefore
encouraged to load and test the software's suitability as regards their
requirements in conditions enabling the security of their systems and/or 
data to be ensured and,  more generally, to use and operate it in the 
same conditions as regards security. 

The fact that you are presently reading this means that you have had
knowledge of the CeCILL license and that you accept its terms.}
unit UAppliqueRepartEssais;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Buttons, ExtCtrls, StdCtrls, ComCtrls;

type
  TAppliqueRepartEssaisDLGForm = class(TForm)
    Panel2: TPanel;
    Label1: TLabel;
    Label2: TLabel;
    STDispoListBox: TListBox;
    SelectAllButton: TButton;
    SelectButton: TButton;
    UnSelectButton: TButton;
    UnSelectAllButton: TButton;
    STSelectListBox: TListBox;
    PageControl2: TPageControl;
    TabSheet3: TTabSheet;
    ListeEssaisLabeledEdit: TLabeledEdit;
    ListeEssaisRadioGroup: TRadioGroup;
    TabSheet4: TTabSheet;
    TaillePaquetLabeledEdit: TLabeledEdit;
    TaillePAquetRadioGroup: TRadioGroup;
    AppliquerRepartEssaisALPHATimer: TTimer;
    Panel1: TPanel;
    BitBtn1: TBitBtn;
    AppliquerSpeedBut: TSpeedButton;
    procedure AppliquerRepartEssaisALPHATimerTimer(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure SelectAllButtonClick(Sender: TObject);
    procedure SelectButtonClick(Sender: TObject);
    procedure UnSelectAllButtonClick(Sender: TObject);
    procedure UnSelectButtonClick(Sender: TObject);
		procedure repSelection;
		procedure repPaquet;
    procedure BitBtn1Click(Sender: TObject);
    procedure AppliquerSpeedButClick(Sender: TObject);
  private
    { Déclarations privées }
    numSession : integer;
    procedure appliquerListe(listeEssai : array of integer;taillePaquet : integer);//Appliquer selon liste
    procedure appliquerAleat1(listeEssai : array of integer;taillePaquet : integer);//Appliquer aleat1
    procedure appliquerAleat2(listeEssai : array of integer;taillePaquet : integer);//Appliquer aleat2

  public
    { Déclarations publiques }
  end;

var
  AppliqueRepartEssaisDLGForm: TAppliqueRepartEssaisDLGForm;

implementation

uses UDocometre, UStatsRepartEssais;

{$R *.dfm}

procedure TAppliqueRepartEssaisDLGForm.AppliquerRepartEssaisALPHATimerTimer(
  Sender: TObject);
begin
  if ALphaBlendValue < 240
  then ALphaBlendValue := ALphaBlendValue + 40
  else begin
    ALphaBlendValue := 255;
    AppliquerRepartEssaisALPHATimer.Enabled := false;
  end;
end;

procedure TAppliqueRepartEssaisDLGForm.FormShow(Sender: TObject);
var i : integer;
begin
  numSession := DocoForm.OrgaFrame.SelectedSessionRow - 1 ;
  ALphaBlendValue := 0;
  AppliquerRepartEssaisALPHATimer.Enabled := true;
  STDispoListBox.Clear;
  STSelectListBox.Clear;
  for i := 0 to DocDOCOMETRE.ST.Count - 1
  do STDispoListBox.Items.Add(DocDOCOMETRE.ST[i].NOM);
end;

procedure TAppliqueRepartEssaisDLGForm.SelectAllButtonClick(
  Sender: TObject);
var i : integer;
begin
  for i := 0 to STDispoListBox.Items.Count - 1
  do STSelectListBox.Items.Add(STDispoListBox.Items[i]);
  STDispoListBox.Clear;
end;

procedure TAppliqueRepartEssaisDLGForm.SelectButtonClick(Sender: TObject);
var i : integer;
begin
  i := 0;
  while (i+1) <= STDispoListBox.Items.Count do
  begin
    if STDispoListBox.Selected[i] then
    begin
      STSelectListBox.Items.Add(STDispoListBox.Items[i]);
      STDispoListBox.Items.Delete(i);
    end else inc(i);
  end;
end;

procedure TAppliqueRepartEssaisDLGForm.UnSelectAllButtonClick(
  Sender: TObject);
var i : integer;
begin
  for i := 0 to STSelectListBox.Items.Count - 1
  do STDispoListBox.Items.Add(STSelectListBox.Items[i]);
  STSelectListBox.Clear;
end;

procedure TAppliqueRepartEssaisDLGForm.UnSelectButtonClick(
  Sender: TObject);
var i : integer;
begin
  i := 0;
  while (i+1) <= STSelectListBox.Items.Count do
  begin
    if STSelectListBox.Selected[i] then
    begin
      STDispoListBox.Items.Add(STSelectListBox.Items[i]);
      STSelectListBox.Items.Delete(i);
    end else inc(i);
  end;
end;

procedure TAppliqueRepartEssaisDLGForm.appliquerListe(listeEssai : array of integer;taillePaquet : integer);//Appliquer selon liste
var i,numST : integer;
begin
  if high(listeEssai) > -1 then//taille paquet=1
  begin
    numST := 0;
    for i := 0 to high(listeEssai) do
    begin
      if listeEssai[i] > -1 then
      begin
        DocDOCOMETRE.SESSIONS[numSession].ESSAIS[listeEssai[i]].NOMST := STSelectListBox.Items[numST];
        inc(numST);
        numST := numST mod STSelectListBox.Count;
        //if numST = STSelectListBox.Count then numST :=0;
      end;
    end;
  end else
  begin
    numST := 0;
    i := 0;
    repeat
      DocDOCOMETRE.SESSIONS[numSession].ESSAIS[i].NOMST := STSelectListBox.Items[numST];
      inc(i);
      numST := (i - (taillePaquet*STSelectListBox.Count)*(i div (taillePaquet*STSelectListBox.Count))) div taillePaquet;
    until i = DocDOCOMETRE.SESSIONS[numSession].ESSAIS.Count;
  end;
end;

procedure TAppliqueRepartEssaisDLGForm.appliquerAleat1(listeEssai : array of integer;taillePaquet : integer);//Appliquer aleat1
var i,numST,nbEssais,n : integer;
    mean : double;
    occurences : array of integer;
begin
  if high(listeEssai) > -1 then//taille paquet=1
  begin
    nbEssais := 0;
    for i := 0 to high(listeEssai)
    do if listeEssai[i] > -1 then inc(nbEssais);
    mean := nbEssais/STSelectListBox.Count;
    setLength(occurences,STSelectListBox.Count);
    i := 0;
    repeat
      if listeEssai[i] > -1 then
      begin
        numST := random(STSelectListBox.Count);
        if occurences[numST] < mean then
        begin
          DocDOCOMETRE.SESSIONS[numSession].ESSAIS[listeEssai[i]].NOMST := STSelectListBox.Items[numST];
          inc(occurences[numST]);
          inc(i);
        end;
      end;
    until i = nbEssais;
    setLength(occurences,0);
  end else
  begin
    mean := DocDOCOMETRE.SESSIONS[numSession].ESSAIS.Count/STSelectListBox.Count;
    setLength(occurences,STSelectListBox.Count);
    i := 0;
    repeat
      numST := random(STSelectListBox.Count);
			n := 0;
			repeat
				if occurences[numST] < mean then
				begin
					DocDOCOMETRE.SESSIONS[numSession].ESSAIS[i].NOMST := 
STSelectListBox.Items[numST];
					inc(i);
					inc(occurences[numST]);
				end;
				inc(n);
			until n = taillePaquet;
		until i = DocDOCOMETRE.SESSIONS[numSession].ESSAIS.Count;
	end;
end;

procedure TAppliqueRepartEssaisDLGForm.appliquerAleat2(listeEssai : array of integer;taillePaquet : integer);//Appliquer aleat2
var i,numST,nbEssais,n,m,o : integer;
    mean : double;
		occurences : array of integer;
		label goAgain;
begin
	if high(listeEssai) > -1 then//taille paquet=1
  begin

		nbEssais := 0;
		for i := 0 to high(listeEssai)
		do if listeEssai[i] > -1 then inc(nbEssais);
		mean := nbEssais/STSelectListBox.Count;
goAgain:
		setLength(occurences,STSelectListBox.Count);
		i := 0;
		repeat
			if listeEssai[i] > -1 then
			begin
				numST := random(STSelectListBox.Count);
				if occurences[numST] < mean then
				begin
					if (i>0)then
					begin
						if (STSelectListBox.Items[numST] <>
								
DocDOCOMETRE.SESSIONS[numSession].ESSAIS[listeEssai[i-1]].NOMST) then
						begin
							
DocDOCOMETRE.SESSIONS[numSession].ESSAIS[listeEssai[i]].NOMST := STSelectListBox.Items[numST];
							inc(occurences[numST]);
							inc(i);
						end else
						begin
							n := 0;
							o := 0;
							for m := 0 to STSelectListBox.Count - 1
							do if occurences[m] >= mean then inc(n) else o := m;
							if n = STSelectListBox.Count - 1 then
							begin
								if i < nbEssais then
								begin
									
DocDOCOMETRE.SESSIONS[numSession].ESSAIS[listeEssai[i]].NOMST := STSelectListBox.Items[o];
									inc(occurences[o]);
									inc(i);
								end;
							end;
						end;
					end else
					begin
						DocDOCOMETRE.SESSIONS[numSession].ESSAIS[listeEssai[i]].NOMST := 
STSelectListBox.Items[numST];
						inc(occurences[numST]);
						inc(i);
					end;
				end;
			end;
		until i = nbEssais;
		setLength(occurences,0);
		if DocDOCOMETRE.SESSIONS[numSession].ESSAIS[listeEssai[i-1]].NOMST =
			 DocDOCOMETRE.SESSIONS[numSession].ESSAIS[listeEssai[i-2]].NOMST
		then goto goAgain;
	end else
	begin
		{ds ce cas il n'y a pas de repartition par paquet}
	end;
end;
//*********************************
//Repartition par sélection d'essai
//*********************************

procedure TAppliqueRepartEssaisDLGForm.repSelection;
var S : string;
    nbEssaisMax,n,n1,n2,i,j : integer;
    listeNumEssais : array of integer;
    fin : boolean;
    listeEssais : TStringList;
begin
	//Construction liste des essais
  S := ListeEssaisLabeledEdit.Text;
  numSession := DocoForm.OrgaFrame.SelectedSessionRow - 1;
  nbEssaisMax := DocDOCOMETRE.SESSIONS[numSession].ESSAIS.Count;
  setLength(listeNumEssais,nbEssaisMax);
  for i := 0 to high(listeNumEssais)
  do listeNumEssais[i] := -1;
  listeEssais := TStringList.create;

  fin := false;
  repeat
    if pos(';',S) <> 0 then
    begin
      listeEssais.Add(copy(S,1,pos(';',S)-1));
      delete(S,1,pos(';',S));
    end else
    begin
      listeEssais.Add(S);
      fin := true;
    end;
  until fin;

  n := 0;
  for i := 0 to listeEssais.Count - 1 do
  begin
    S := listeEssais[i];
    if pos('-',S) <> 0 then
    begin
      n1 := strtoint(copy(S,1, pos('-',S)-1));
      n2 := strtoint(copy(S,pos('-',S)+1,length(S)));
      if n1<=nbEssaisMax then
      begin
        if n2>nbEssaisMax then n2 := nbEssaisMax;
        for j := n1 to n2 do
        begin
          listeNumEssais[n] := j-1;
          inc(n);
        end;
      end;
    end else
    begin
      n1 := strtoint(S);
      if n1<=nbEssaisMax then
      begin
        listeNumEssais[n] := n1-1;
        inc(n);
      end;
    end;
  end;

  if STSelectListBox.Items.Count > 0 then
  begin
    case ListeEssaisRadioGroup.ItemIndex of
      0:appliquerListe(ListeNumEssais,1);//Appliquer selon liste
      1:appliquerAleat1(ListeNumEssais,1);//Appliquer aleat1
      2:appliquerAleat2(ListeNumEssais,1);//Appliquer aleat2
    end;
     DocoForm.OrgaFrame.MAJIHM;
  end;
  setLength(listeNumEssais,0);
  listeEssais.Free;
end;

//*********************************
//Repartition par sélection d'essai
//*********************************


//*********************************
//Repartition par paquet d'essai
//*********************************

procedure TAppliqueRepartEssaisDLGForm.repPaquet;
var ListeNumEssais : array of integer;
    taillePaquet : integer;
begin
	taillePaquet := strtoint(TaillePaquetLabeledEdit.Text);
  if taillePaquet > 0 then
  begin
    if STSelectListBox.Items.Count > 0 then
    begin
      setLength(ListeNumEssais,0);
      case TaillePAquetRadioGroup.ItemIndex of
        0:appliquerListe(ListeNumEssais,taillePaquet);//Appliquer selon liste
        1:appliquerAleat1(ListeNumEssais,taillePaquet);//Appliquer aleat1
      end;
      DocoForm.OrgaFrame.MAJIHM;
    end;
  end;
end;

//*********************************
//Repartition par paquet d'essai
//*********************************

procedure TAppliqueRepartEssaisDLGForm.BitBtn1Click(Sender: TObject);
begin
  hide;
end;

procedure TAppliqueRepartEssaisDLGForm.AppliquerSpeedButClick(
  Sender: TObject);
begin
	case PageControl2.ActivePageIndex of
		0 : repSelection;
		1 : repPaquet;
	end;
	StatsRepartEssaisDLGForm.refreshStat;
end;

end.
