static inline
jl_value_t *jl_iintrinsic_1(jl_value_t *ty, jl_value_t *a, const char *name,
char (*getsign)(void*, unsigned),
jl_value_t *(*lambda1)(jl_value_t*, void*, unsigned, unsigned, const void*), const void *list)
{
if (!jl_is_bitstype(jl_typeof(a)))
jl_errorf("%s: value is not a bitstype", name);
if (!jl_is_bitstype(ty))
jl_errorf("%s: type is not a bitstype", name);
void *pa = jl_data_ptr(a);
unsigned isize = jl_datatype_size(jl_typeof(a));
unsigned isize2 = next_power_of_two(isize);
unsigned osize = jl_datatype_size(ty);
unsigned osize2 = next_power_of_two(osize);
if (isize2 > osize2)
osize2 = isize2;
if (osize2 > isize || isize2 > isize) {
/* if needed, round type up to a real c-type and set/clear the unused bits */
void *pa2;
pa2 = alloca(osize2);
/* TODO: this memcpy assumes little-endian,
* for big-endian, need to align the copy to the other end */ \
memcpy(pa2, pa, isize);
memset((char*)pa2 + isize, getsign(pa, isize), osize2 - isize);
pa = pa2;
}
jl_value_t *newv = lambda1(ty, pa, osize, osize2, list);
if (ty == (jl_value_t*)jl_bool_type)
return *(uint8_t*)jl_data_ptr(newv) & 1 ? jl_true : jl_false;
return newv;
}
RcppExport SEXP nsem3b(SEXP data,
SEXP theta,
SEXP Sigma,
SEXP modelpar,
SEXP control
) {
// srand ( time(NULL) ); /* initialize random seed: */
Rcpp::NumericVector Theta(theta);
Rcpp::NumericMatrix D(data);
unsigned nobs = D.nrow(), k = D.ncol();
mat Data(D.begin(), nobs, k, false); // Avoid copying
Rcpp::NumericMatrix V(Sigma);
mat S(V.begin(), V.nrow(), V.ncol());
S(0,0) = 1;
mat iS = inv(S);
double detS = det(S);
Rcpp::List Modelpar(modelpar);
// Rcpp::IntegerVector _nlatent = Modelpar["nlatent"]; unsigned nlatent = _nlatent[0];
Rcpp::IntegerVector _ny0 = Modelpar["nvar0"]; unsigned ny0 = _ny0[0];
Rcpp::IntegerVector _ny1 = Modelpar["nvar1"]; unsigned ny1 = _ny1[0];
Rcpp::IntegerVector _ny2 = Modelpar["nvar2"]; unsigned ny2 = _ny2[0];
Rcpp::IntegerVector _npred0 = Modelpar["npred0"]; unsigned npred0 = _npred0[0];
Rcpp::IntegerVector _npred1 = Modelpar["npred1"]; unsigned npred1 = _npred1[0];
Rcpp::IntegerVector _npred2 = Modelpar["npred2"]; unsigned npred2 = _npred2[0];
Rcpp::List Control(control);
Rcpp::NumericVector _lambda = Control["lambda"]; double lambda = _lambda[0];
Rcpp::NumericVector _niter = Control["niter"]; double niter = _niter[0];
Rcpp::NumericVector _Dtol = Control["Dtol"]; double Dtol = _Dtol[0];
rowvec mu0(ny0), lambda0(ny0);
rowvec mu1(ny1), lambda1(ny1);
rowvec mu2(ny2), lambda2(ny2);
rowvec beta0(npred0);
rowvec beta1(npred1);
rowvec beta2(npred2);
rowvec gamma(2);
rowvec gamma2(2);
unsigned pos=0;
for (unsigned i=0; i<ny0; i++) {
mu0(i) = Theta[pos];
pos++;
}
for (unsigned i=0; i<ny1; i++) {
mu1(i) = Theta[pos];
pos++;
}
for (unsigned i=0; i<ny2; i++) {
mu2(i) = Theta[pos];
pos++;
}
for (unsigned i=0; i<ny0; i++) {
lambda0(i) = Theta[pos];
pos++;
}
lambda1(0) = 1;
for (unsigned i=1; i<ny1; i++) {
lambda1(i) = Theta[pos];
pos++;
}
lambda2(0) = 1;
for (unsigned i=1; i<ny2; i++) {
lambda2(i) = Theta[pos];
pos++;
}
for (unsigned i=0; i<npred0; i++) {
beta0(i) = Theta[pos];
pos++;
}
for (unsigned i=0; i<npred1; i++) {
beta1(i) = Theta[pos];
pos++;
}
for (unsigned i=0; i<npred2; i++) {
beta2(i) = Theta[pos];
pos++;
}
gamma(0) = Theta[pos]; gamma(1) = Theta[pos+1];
gamma2(0) = Theta[pos+2]; gamma2(1) = Theta[pos+3];
// cerr << "mu0=" << mu0 << endl;
// cerr << "mu1=" << mu1 << endl;
// cerr << "mu2=" << mu2 << endl;
// cerr << "lambda0=" << lambda0 << endl;
// cerr << "lambda1=" << lambda1 << endl;
// cerr << "lambda2=" << lambda2 << endl;
// cerr << "beta0=" << beta0 << endl;
// cerr << "beta1=" << beta1 << endl;
// cerr << "beta2=" << beta2 << endl;
// cerr << "gamma=" << gamma << endl;
// cerr << "gamma2=" << gamma2 << endl;
mat lap(nobs,4);
for (unsigned i=0; i<nobs; i++) {
rowvec newlap = laNRb(Data.row(i), iS, detS,
mu0, mu1, mu2,
lambda0, lambda1, lambda2,
beta0,beta1, beta2, gamma, gamma2,
Dtol,niter,lambda);
lap.row(i) = newlap;
}
List res;
res["indiv"] = lap;
res["logLik"] = sum(lap.col(0)) + (3-V.nrow())*log(2.0*datum::pi)*nobs/2;
res["norm0"] = (3-V.nrow())*log(2*datum::pi)/2;
return res;
}
SSVUT_EXPECT(SSVPP_TPL_ELEM(SSVPP_TPL_PUSH_BACK((1, 2), 3), 0) == 1);
SSVUT_EXPECT(SSVPP_TPL_ELEM(SSVPP_TPL_PUSH_BACK((1, 2), 3), 2) == 3);
}
{
SSVUT_EXPECT(SSVPP_TPL_SIZE(SSVPP_TPL_FILL(())) == SSVPP_TPL_MAX_SIZE);
SSVUT_EXPECT(SSVPP_TPL_SIZE(SSVPP_TPL_FILL((1))) == SSVPP_TPL_MAX_SIZE);
SSVUT_EXPECT(SSVPP_TPL_SIZE(SSVPP_TPL_FILL((1, 1))) == SSVPP_TPL_MAX_SIZE);
SSVUT_EXPECT(SSVPP_TPL_SIZE(SSVPP_TPL_FILL((1, 1, 1))) == SSVPP_TPL_MAX_SIZE);
}
{
#define SSVU_TEST_GEN_LMBD(mReturn, mName, mBody) auto mName = []() -> mReturn { mBody };
SSVU_TEST_GEN_LMBD(__R(std::pair<int, int>), __R(lambda1), __R(return std::make_pair(1, 5);));
SSVU_TEST_GEN_LMBD(__R(std::pair<int, std::pair<float, float>>), __R(lambda2), __R(return std::make_pair(2, std::pair<float, float>(1.5f, 2.5f));));
SSVUT_EXPECT(lambda1().first == 1);
SSVUT_EXPECT(lambda1().second == 5);
SSVUT_EXPECT(lambda2().first == 2);
SSVUT_EXPECT(lambda2().second.first == 1.5f);
SSVUT_EXPECT(lambda2().second.second == 2.5f);
#undef SSVU_TEST_GEN_LMBD
}
}
#endif
static double refmap_tetra_f0(double x, double y, double z) { return lambda1(x, y, z); }