Exemple #1
0
SEXP kmeansRNumericMatrix(SEXP x, SEXP cen, SEXP clust, SEXP clustsizes,
                          SEXP wss, SEXP itermax, SEXP dist)
{
  index_type numRows = static_cast<index_type>(Rf_nrows(x));
  index_type numCols = static_cast<index_type>(Rf_ncols(x));
  int dist_calc = INTEGER(dist)[0];
  MatrixAccessor<double> mat(REAL(x), numRows);
    if (dist_calc==0) {
       return kmeansMatrixEuclid<double, MatrixAccessor<double> >(mat,
                numRows, numCols, cen, clust, clustsizes, wss, itermax);
    } else {
        return kmeansMatrixCosine<double, MatrixAccessor<double> >(mat,
                numRows, numCols, cen, clust, clustsizes, wss, itermax);
    }
}
Exemple #2
0
SEXP pathSearch(SEXP Rx, SEXP Ry, SEXP Romega, SEXP Rlambda, SEXP Rkappa,
                SEXP Rtheta, SEXP Rn_lambda, SEXP Rn_theta,
                SEXP Reps, SEXP Rmax, SEXP Rinmax, SEXP Rpenalty, SEXP Rinit)
{
  const char *penalty;
  int  i, j, l, n, p, max, iter[1], n_lambda, n_theta, inmax;
  double eps;
  double *lambda, *y, *x, *init, *in, kappa, *theta, *omega;
  void cdfit(), free_vec();
  SEXP betahat,  betatild, Riter, return_list;
  p = Rf_ncols(Rx);
  n = Rf_nrows(Rx);
  Rx = coerceVector(Rx, REALSXP);
  Ry = coerceVector(Ry, REALSXP);
  Romega = coerceVector(Romega, REALSXP);
  Rlambda = coerceVector(Rlambda, REALSXP);
  Rkappa = coerceVector(Rkappa, REALSXP);
  Rtheta = coerceVector(Rtheta, REALSXP);
  Rn_lambda = coerceVector(Rn_lambda, INTSXP);
  Rn_theta = coerceVector(Rn_theta, INTSXP);
  Reps = coerceVector(Reps, REALSXP);
  Rinit = coerceVector(Rinit, REALSXP);
  Rmax = coerceVector(Rmax, INTSXP);
  Rinmax = coerceVector(Rinmax, INTSXP);


  lambda = REAL(Rlambda);
  kappa = REAL(Rkappa)[0];
  theta = REAL(Rtheta);
  penalty = CHAR(STRING_ELT(Rpenalty, 0));
  n_lambda = INTEGER(Rn_lambda)[0];
  n_theta = INTEGER(Rn_theta)[0];
  eps = REAL(Reps)[0];
  max = INTEGER(Rmax)[0];
  inmax = INTEGER(Rinmax)[0];
  x = REAL(Rx);
  y = REAL(Ry);
  omega = REAL(Romega);
  in = REAL(Rinit);
  init = vector(p);
  for (j = 0; j < p; j++) init[j] = in[j];
  PROTECT(betahat = Rf_allocMatrix(REALSXP, p, n_lambda * n_theta));
  PROTECT(betatild = Rf_allocMatrix(REALSXP, p, n_lambda * n_theta));
  PROTECT(Riter = Rf_allocMatrix(INTSXP, n_lambda, n_theta));
  PROTECT(return_list = Rf_allocVector(VECSXP, 6));
  /*LASSO path along lambda*/
  for (i = 0; i < n_lambda; i++){
    for (l = 0; l < n_theta; l++)
    {
      cdfit(x, y, omega, init, lambda[i], 0.0, theta[l], "LASSO", eps, max,
      inmax, n, p, iter);
      for (j = 0; j < p; j++)
        REAL(betahat)[(i + l * n_lambda) * p + j] = init[j];
      INTEGER(Riter)[i + l * n_lambda] = iter[0];
    }}
  SET_VECTOR_ELT(return_list, 0, betahat);
  /*MCP path along kappa with n_lambda interim points*/
  if (strcmp(penalty, "MCP") == 0)
  {
    for (i = 0; i < n_lambda; i++)
    {
      for (l = 0; l < n_theta; l++)
      {
        for (j = 0; j < p; j++) init[j] = REAL(betahat)[(i + l * n_lambda) * p + j];
        cdfit(x, y, omega, init, lambda[i], kappa, theta[l], "MCP", eps, max,
        inmax, n, p, iter);
        for (j = 0; j < p; j++)
          REAL(betatild)[(i + l * n_lambda) * p + j] = init[j];
        INTEGER(Riter)[i + l * n_lambda] = iter[0];
      }
    }
  }
  SET_VECTOR_ELT(return_list, 1, betatild);
  SET_VECTOR_ELT(return_list, 2, Riter);
  SET_VECTOR_ELT(return_list, 3, Rlambda);
  SET_VECTOR_ELT(return_list, 4, Rkappa);
  SET_VECTOR_ELT(return_list, 5, Rtheta);
  UNPROTECT(4);
  free_vector(init);
  return(return_list);
}
 R_len_t nrow() const { return Rf_nrows(Robject); }