char *
_makearg(FIELDTYPE *t, va_list *ap, int *err)
{
/*
* invoke make_arg function associated with field type t.
* return pointer to argument information or null if none.
* increment err if an error is encountered.
*/
char *p = (char *)0;
if (! t || ! Status(t, ARGS))
return (p);
if (Status(t, LINKED)) {
LINK *n = (LINK *) 0;
if (Alloc(n, LINK)) {
ArgL(n) = _makearg(TypeL(t), ap, err);
ArgR(n) = _makearg(TypeR(t), ap, err);
p = (char *)n;
} else
++(*err); /* out of space */
} else
if (!(p = (*MakeA(t)) (ap)))
++(*err); /* make_arg had problem */
return (p);
}
int
set_fieldtype_arg(FIELDTYPE *t, PTF_charP makearg,
PTF_charP copyarg, PTF_void freearg)
{
if (t && makearg && copyarg && freearg) {
Set(t, ARGS);
MakeA(t) = makearg;
CopyA(t) = copyarg;
FreeA(t) = freearg;
return (E_OK);
}
return (E_BAD_ARGUMENT);
}
void CalcWcluster_C (double * MatKern, int * MxIter, int *nlin, double* MaxValA, double* niu, int* MnW, int* MaxW, double *AroundNull, double * VectorsYA ) {
double W = *MaxW;
double ValW = 0 ;
double TabWPrec = 0 ;
double PreviousW = *MaxW ;
double MinW = *MnW ;
double BoundSup = 1E+10;
double nu = *niu;
double MxValA = *MaxValA;
double AroundNul = *AroundNull;
int N = *nlin;
int Iter = 1;
int MaxIter = *MxIter;
int i = 0;
double * VWA = 0;
//WYA <- list(W="",Y="",A="")
//f = fopen("D:\\R\\library\\svcR\\data\\sortieyy.txt", "w");
//creation of a random vector (randomization uniforme runif) / (randomization gaussienne rnorm)
VWA = (double*)MakeA( N , nu, AroundNul, MxValA ); // WYA$A
// computation of WYA$A bound sup
if( nu && N )
BoundSup = MxValA ; // 1 / ( nu * N );
TabWPrec = MinW;
while( (W > TabWPrec && Iter <= MaxIter) || (Iter <= MaxIter) ) {
PreviousW = W;
W = CritereWcluster(VWA, MatKern, N);
if( Iter > 1 ){
TabWPrec = ValW;
}
if( W > TabWPrec ){
ValW = W;
}
else {
ValW = TabWPrec;
free(VWA);
VWA = MakeA( 2*N+1 , nu, AroundNul, MxValA);
while(
(ConstraintCluster1(BoundSup, VWA, N) == 0)
||
(ConstraintCluster2(VWA, N, AroundNul) == 0)
) {
free(VWA);
VWA = MakeA( N , nu, AroundNul, MxValA);
} //#fin while
} //#finif
PreviousW = W;
W = CritereWcluster(VWA, MatKern, N);
Iter = Iter + 1;
} //finwhile
for ( i = 0; i < 2*N+1; i++){
*(VectorsYA+i) = *(VWA+i);
if( i == N )
*(VectorsYA+N) = W;
//fprintf(f, "%1.6lf \n",*(VectorsYA+i) );
} //endfor
//fprintf(f, "\n");
//fprintf(f, "%2.20lf \t %2.20lf \n",*(VectorsYA+N), W );
//fclose(f);
//f = 0;
return;
}