long __Call_sech( CDSR_VMEval& /*vm*/, MMD_Address& addr, UniWord *arg )
{
#if _DEBUG
if( addr.param2 < 0 )
throw _T("__Call_(fun) : internal error, out of range");
#endif
if( addr.param2 == 0 ) // DSRDATA_TYPE_REAL
*(arg - 1) = CDSRReal( sech( (arg - 1)->getReal() ) );
else // DSRDATA_TYPE_COMPLEX
*(arg - 1) = CDSRComplex( sech( (arg - 1)->getComplex() ) );
return 1 - addr.param3;
}
bool TrigonometricFunction::unarySech(ExecutionContext *context, QString *err)
{
switch (context->obligArg().type()) {
case PretexVariant::Int:
context->setReturnValue(sech(context->obligArg().toInt()));
break;
case PretexVariant::Real:
context->setReturnValue(sech(context->obligArg().toReal()));
break;
case PretexVariant::String:
default:
return bRet(err, tr("Invalid argument type", "error"), false);
}
return bRet(err, QString(), true);
}
main()
{
int i, q, a;
long int k;
static STRU x[16] = {{101, "Zhao", 'M', 19},
{102, "Qian", 'F', 18}, {103, "Sun", 'M', 19},
{104, "Li", 'F', 20}, {105, "Zhou", 'M', 19},
{106, "Wu", 'F', 18}, {107, "Zheng", 'M', 17},
{108, "Wang", 'F', 21}, {109, "Jiang", 'M', 19},
{110, "Shen", 'F', 18}, {111, "Chu", 'M', 19},
{112, "Wei", 'F', 19}, {113, "He", 'M', 18},
{114, "Lv", 'F', 18}, {115, "Shi", 'M', 19},
{110, "Zhang", 'F', 18}
};
FILE* fp;
STRU str;
printf("Serch from Array: \n");
a = 18;
i = 0;
do {
q = sech(x, 16, i, a); /* 查找并打印*/
if (q != -1)
printf("%-5d%-8s%-2c%-2d%\n", x[q].num,
x[q].name, x[q].sex, x[q].age);
i = q + 1;
} while (q != -1);
k = sizeof(STRU);
fp = fopen("stu.dat", "w+"); /* 打开文件写*/
for (i = 0; i < 16; i++)
if (fwrite(&x[i], k, 1, fp) != 1) { /* 写入文件*/
printf("Cannot write file\n"); /* 写入失败*/
i = 16;
}
fclose(fp);
printf("\nSerch from File: \n");
fp = fopen("stu.dat", "r+"); /* 打开文件读*/
do {
q = Fsech(fp, a, &str); /* 查找并打印*/
if (q)
printf("%-5d%-8s%-2c%-2d%\n", str.num,
str.name, str.sex, str.age);
} while (q);
fclose(fp);
}
//This function will calculate the Jocobian for the errors
SEXP jacobian_(SEXP X, SEXP n, SEXP p, SEXP theta, SEXP neurons,SEXP J, SEXP reqCores)
{
int i,j,k;
double z,dtansig;
int useCores, haveCores;
double *pX;
double *ptheta;
double *pJ;
int rows, columns, nneurons;
SEXP list;
rows=INTEGER_VALUE(n);
columns=INTEGER_VALUE(p);
nneurons=INTEGER_VALUE(neurons);
PROTECT(X=AS_NUMERIC(X));
pX=NUMERIC_POINTER(X);
PROTECT(theta=AS_NUMERIC(theta));
ptheta=NUMERIC_POINTER(theta);
PROTECT(J=AS_NUMERIC(J));
pJ=NUMERIC_POINTER(J);
/*
Set the number of threads
*/
#ifdef _OPENMP
//R_CStackLimit=(uintptr_t)-1;
useCores=INTEGER_VALUE(reqCores);
haveCores=omp_get_num_procs();
if(useCores<=0 || useCores>haveCores) useCores=haveCores;
omp_set_num_threads(useCores);
#endif
#pragma omp parallel private(j,k,z,dtansig)
{
#pragma omp for schedule(static)
for(i=0; i<rows; i++)
{
//Rprintf("i=%d\n",i);
for(k=0; k<nneurons; k++)
{
z=0;
for(j=0;j<columns;j++)
{
z+=pX[i+(j*rows)]*ptheta[(columns+2)*k+j+2];
}
z+=ptheta[(columns+2)*k+1];
dtansig=pow(sech(z),2.0);
/*
Derivative with respect to the weight
*/
pJ[i+(((columns+2)*k)*rows)]=-tansig(z);
/*
Derivative with respect to the bias
*/
pJ[i+(((columns+2)*k+1)*rows)]=-ptheta[(columns+2)*k]*dtansig;
/*
Derivate with respect to the betas
*/
for(j=0; j<columns;j++)
{
pJ[i+(((columns+2)*k+j+2)*rows)]=-ptheta[(columns+2)*k]*dtansig*pX[i+(j*rows)];
}
}
}
}
PROTECT(list=allocVector(VECSXP,1));
SET_VECTOR_ELT(list,0,J);
UNPROTECT(4);
return(list);
}
//This function will calculate the Jocobian for the errors
SEXP jacobian_(SEXP X, SEXP n, SEXP p, SEXP theta, SEXP neurons,SEXP J, SEXP reqCores)
{
int i,j,k;
double z,dtansig;
double *pX;
double *ptheta;
double *pJ;
int rows, columns, nneurons;
SEXP list;
rows=INTEGER_VALUE(n);
columns=INTEGER_VALUE(p);
nneurons=INTEGER_VALUE(neurons);
PROTECT(X=AS_NUMERIC(X));
pX=NUMERIC_POINTER(X);
PROTECT(theta=AS_NUMERIC(theta));
ptheta=NUMERIC_POINTER(theta);
PROTECT(J=AS_NUMERIC(J));
pJ=NUMERIC_POINTER(J);
for(i=0; i<rows; i++)
{
//Rprintf("i=%d\n",i);
for(k=0; k<nneurons; k++)
{
z=0;
for(j=0;j<columns;j++)
{
z+=pX[i+(j*rows)]*ptheta[(columns+2)*k+j+2];
}
z+=ptheta[(columns+2)*k+1];
dtansig=pow(sech(z),2.0);
/*
Derivative with respect to the weight
*/
pJ[i+(((columns+2)*k)*rows)]=-tansig(z);
/*
Derivative with respect to the bias
*/
pJ[i+(((columns+2)*k+1)*rows)]=-ptheta[(columns+2)*k]*dtansig;
/*
Derivate with respect to the betas
*/
for(j=0; j<columns;j++)
{
pJ[i+(((columns+2)*k+j+2)*rows)]=-ptheta[(columns+2)*k]*dtansig*pX[i+(j*rows)];
}
}
}
PROTECT(list=allocVector(VECSXP,1));
SET_VECTOR_ELT(list,0,J);
UNPROTECT(4);
return(list);
}
