static SEXP CreateHess(SEXP names)
{
SEXP p, q, data, dim, dimnames;
int i, n;
n = length(names);
PROTECT(dimnames = lang4(R_NilValue, R_NilValue, R_NilValue, R_NilValue));
SETCAR(dimnames, install("list"));
p = install("c");
PROTECT(q = allocList(n));
SETCADDR(dimnames, LCONS(p, q));
UNPROTECT(1);
for(i = 0 ; i < n ; i++) {
SETCAR(q, ScalarString(STRING_ELT(names, i)));
q = CDR(q);
}
SETCADDDR(dimnames, duplicate(CADDR(dimnames)));
PROTECT(dim = lang4(R_NilValue, R_NilValue, R_NilValue,R_NilValue));
SETCAR(dim, install("c"));
SETCADR(dim, lang2(install("length"), install(".value")));
SETCADDR(dim, ScalarInteger(length(names)));
SETCADDDR(dim, ScalarInteger(length(names)));
PROTECT(data = ScalarReal(0.));
PROTECT(p = lang4(install("array"), data, dim, dimnames));
p = lang3(install("<-"), install(".hessian"), p);
UNPROTECT(4);
return p;
}
static SEXP
summary_func_user_Rfunc (Sampler *ss, int currentPeriod, SEXP currentStreams,
SEXP currentLogWeights)
{
ArgsList2 *al = ss->summaryArgsList;
INTEGER(ss->SEXPCurrentPeriod)[0] = currentPeriod + 1;
SET_VECTOR_ELT(al->argsList, al->posCurrentPeriod, ss->SEXPCurrentPeriod);
SET_VECTOR_ELT(al->argsList, al->posCurrentStreams, currentStreams);
SET_VECTOR_ELT(al->argsList, al->posCurrentLogWeights, currentLogWeights);
SETCADR(ss->doCallFuncCall, ss->summaryFunc);
SETCADDR(ss->doCallFuncCall, al->argsList);
SETCADDDR(ss->doCallFuncCall, ss->dotsList);
return eval(ss->doCallFuncCall, ss->doCallFuncEnv);
}
static SEXP
propagate_func_user_Rfunc (Sampler *ss, int currentPeriod, int nStreamsToGenerate,
SEXP lag1Streams, SEXP lag1LogWeights)
{
ArgsList1 *al = ss->propagateArgsList;
INTEGER(ss->SEXPCurrentPeriod)[0] = currentPeriod + 1;
INTEGER(ss->SEXPNStreamsToGenerate)[0] = nStreamsToGenerate;
SET_VECTOR_ELT(al->argsList, al->posCurrentPeriod, ss->SEXPCurrentPeriod);
SET_VECTOR_ELT(al->argsList, al->posNStreamsToGenerate, ss->SEXPNStreamsToGenerate);
SET_VECTOR_ELT(al->argsList, al->posLag1Streams, lag1Streams);
SET_VECTOR_ELT(al->argsList, al->posLag1LogWeights, lag1LogWeights);
SETCADR(ss->doCallFuncCall, ss->propagateFunc);
SETCADDR(ss->doCallFuncCall, al->argsList);
SETCADDDR(ss->doCallFuncCall, ss->dotsList);
return eval(ss->doCallFuncCall, ss->doCallFuncEnv);
}
static SEXP
MHUpdate_func_user_Rfunc (Sampler *ss, int currentPeriod, int nMHSteps,
SEXP currentStreams, SEXP lag1Streams,
SEXP lag1LogWeights)
{
ArgsList3 *al = ss->MHUpdateArgsList;
INTEGER(ss->SEXPCurrentPeriod)[0] = currentPeriod + 1;
INTEGER(ss->SEXPNMHSteps)[0] = nMHSteps;
SET_VECTOR_ELT(al->argsList, al->posCurrentPeriod, ss->SEXPCurrentPeriod);
SET_VECTOR_ELT(al->argsList, al->posNMHSteps, ss->SEXPNMHSteps);
SET_VECTOR_ELT(al->argsList, al->posCurrentStreams, currentStreams);
SET_VECTOR_ELT(al->argsList, al->posLag1Streams, lag1Streams);
SET_VECTOR_ELT(al->argsList, al->posLag1LogWeights, lag1LogWeights);
SETCADR(ss->doCallFuncCall, ss->MHUpdateFunc);
SETCADDR(ss->doCallFuncCall, al->argsList);
SETCADDDR(ss->doCallFuncCall, ss->dotsList);
return eval(ss->doCallFuncCall, ss->doCallFuncEnv);
}
static Rboolean
resampCriterion_func_user_Rfunc (Sampler *ss, int currentPeriod, SEXP currentStreams,
SEXP currentLogWeights)
{
ArgsList2 *al = ss->resampCriterionArgsList;
SEXP SEXPTmp;
Rboolean res;
INTEGER(ss->SEXPCurrentPeriod)[0] = currentPeriod + 1;
SET_VECTOR_ELT(al->argsList, al->posCurrentPeriod, ss->SEXPCurrentPeriod);
SET_VECTOR_ELT(al->argsList, al->posCurrentStreams, currentStreams);
SET_VECTOR_ELT(al->argsList, al->posCurrentLogWeights, currentLogWeights);
SETCADR(ss->doCallFuncCall, ss->resampCriterionFunc);
SETCADDR(ss->doCallFuncCall, al->argsList);
SETCADDDR(ss->doCallFuncCall, ss->dotsList);
PROTECT(SEXPTmp = eval(ss->doCallFuncCall, ss->doCallFuncEnv));
res = LOGICAL(SEXPTmp)[0];
UNPROTECT(1);
return res;
}
