Esempio n. 1
0
//[[Rcpp::export]]
IntegerVector whichNA(arma::mat X) {
  NumericVector x(X.begin(), X.end());
  int n = x.size();
  IntegerVector y = seq_len(n);//(x.begin(), x.end());
  IntegerVector z = y[is_na(x)];
  if(z.size()==0)
    std::cout << "\nNenhum valor faltante.\n";
  return z;
}
Esempio n. 2
0
//[[Rcpp::export]]
Rcpp::List changeNA(arma::mat X) {
  NumericVector x(X.begin(), X.end());
  int n = x.size();
  IntegerVector y = seq_len(n)-1;//(x.begin(), x.end());
  IntegerVector z = y[is_na(x)];
  if(z.size()==0){
    std::cout << "Nenhum valor faltante.\n";
    SEXP xNULL = R_NilValue;
    return Rcpp::List::create(xNULL);  
  } else{
    arma::uvec Xna = as<arma::uvec>(z);
    NumericVector bx(Xna.n_rows, 100.0);
    arma::vec b = as<arma::vec>(bx);
    X.elem(Xna) = b;
    return Rcpp::List::create(X);
  }  
}
Esempio n. 3
0
////> Main function ////
// [[Rcpp::export]]
List calcPotts_cpp (const S4& W_SR, const S4& W_LR, arma::mat sample, NumericVector rho, const arma::mat& coords, 
                    const IntegerVector& site_order, int iter_max, double cv_criterion, 
                    bool test_regional, NumericVector distance_ref, double threshold, double neutre, int nbGroup_min, bool multiV, bool last_vs_others, 
                    bool prior, bool type_reg, int verbose){
  
  //// preparation
  int p = sample.n_cols;
  int n = sample.n_rows;
  
  IntegerVector W_SRi = W_SR.slot("i");
  IntegerVector W_SRp = W_SR.slot("p");
  NumericVector W_SRx = W_SR.slot("x");
  
  arma::mat Wpred(n, p);
   
  vector < vector < double > > pred_global(p);
  for(int iter_p = 0 ; iter_p < p ; iter_p ++){
    pred_global[iter_p].resize(n);
    for(int iter_px = 0 ; iter_px < n ; iter_px++){
      pred_global[iter_p][iter_px] = sample(iter_px, iter_p);
    }
  }
  vector < vector < double > > pred_global_hist = pred_global;
    
  if(prior == false){
    std::fill(sample.begin(), sample.end(), 1);
  }
  
  arma::mat V(n, p);
   
  IntegerVector rang;
  bool no_site_order = (site_order[0] < 0);
  if(no_site_order == false){
    rang = site_order;
  }
  
  int index_px;
  double norm;
  double val_criterion = cv_criterion + 1;
  double diff_criterion = 0, diff; 
  double cv_criterion2 = n * cv_criterion ; 
  int iter_updateV = 0 ;
  
  vector < double > res_multipotentiel(n) ;
  int iter = 0 ;
  
  //// estimation
  
  while(iter < iter_max && ( (val_criterion > cv_criterion) || (test_regional == true && iter_updateV != iter) ) ){

    iter++;
    pred_global_hist = pred_global; 
    
    if(no_site_order){
      rang = rank_hpp(runif(n)) - 1; // tirer aleatoirement l ordre des sites
    }
   
    //// regional potential
    if(test_regional == true){
      if(iter == 1 || val_criterion <= cv_criterion || diff_criterion > cv_criterion2){ 
      iter_updateV = iter ;
      
      for(int iter_p = (p - 1) ; iter_p>= 0 ; iter_p --){

        if(last_vs_others == false || iter_p == (p - 1)){
        
        res_multipotentiel =  calcMultiPotential_hpp(W_SR, W_LR, pred_global[iter_p], 
                                                     threshold, coords, Rcpp::as < std::vector < double > >(distance_ref), 
                                                     nbGroup_min, multiV, 
                                                     neutre)[0]; 
            
          for(int iter_px = 0 ; iter_px < n ; iter_px++){
           
            V(iter_px, iter_p) = res_multipotentiel[iter_px];
            
            if(type_reg){
              V(iter_px, iter_p) = V(iter_px, iter_p)  * (V(iter_px, iter_p) - pred_global[iter_p][iter_px]);
            }
          }
        
        }else{
          V.col(iter_p) = 1 - V.col(p - 1);
        }
      }
      
      }else{
        cv_criterion2 /= 1.1;
      } 
    }

    //// update site probabilities
    val_criterion = 0;
    diff_criterion = 0;
    
    for(int iter_px = 0 ; iter_px < n ; iter_px++){ // pour chaque pixel
      
      norm = 0.0;
      index_px = rang(iter_px);
      
      for(int iter_p = 0 ; iter_p < p ; iter_p++){ // pour chaque groupe
        Wpred(index_px, iter_p) = 0.0;
        
        for(int iter_vois = W_SRp[index_px]; iter_vois < W_SRp[index_px + 1]; iter_vois++){ // pour chaque voisin
          if(type_reg){
            Wpred(index_px, iter_p) += W_SRx[iter_vois]*pred_global[iter_p][W_SRi[iter_vois]]*max(0.0, pred_global[iter_p][W_SRi[iter_vois]]-sample(index_px, iter_p));
            }else{
            Wpred(index_px, iter_p) += W_SRx[iter_vois] *pred_global[iter_p][W_SRi[iter_vois]];
          }
        }
        
        // exponentielle rho
        if(test_regional == false){
          pred_global[iter_p][index_px] = sample(index_px, iter_p) *exp(rho(0) *Wpred(index_px, iter_p)) ;
        }else{
          pred_global[iter_p][index_px] = sample(index_px, iter_p) *exp(rho(0) *Wpred(index_px, iter_p) + rho(1) *V(index_px, iter_p));
        } 
        norm += pred_global[iter_p][index_px];
      } 
      
      // normalisation 
      for(int iter_p = 0 ; iter_p < p ; iter_p++){
        pred_global[iter_p][index_px] /= norm;
        diff = abs(pred_global_hist[iter_p][index_px]-pred_global[iter_p][index_px]);
        diff_criterion += diff;
        val_criterion = max(val_criterion, diff);
      }
      
    }         

    if(verbose > 0){
      if(verbose == 1){Rcout << "*" ;}
      if(verbose == 2){Rcout << "iteration " << iter << " : totaldiff = " << diff_criterion << " | maxdiff = " << val_criterion << endl;}
    }

  }  
  
  if(verbose == 1){Rcout << endl;}
  
  //// export
  arma::mat spatialPrior(n, p);
  for(int iter_px = 0 ; iter_px < n ; iter_px++){
    index_px = rang(iter_px);
    for(int iter_p = 0 ; iter_p < p ; iter_p++){
      if(test_regional == false){
        spatialPrior(index_px, iter_p) = exp(rho(0) *Wpred(index_px, iter_p)) ;
      }else{
          spatialPrior(index_px, iter_p) = exp(rho(0) *Wpred(index_px, iter_p) + rho(1) *V(index_px, iter_p));
      } 
    }
  }
  
  return Rcpp::List::create(Rcpp::Named("predicted") = pred_global, 
                            Rcpp::Named("spatialPrior") = spatialPrior, 
                            Rcpp::Named("cv") = val_criterion <= cv_criterion, 
                            Rcpp::Named("iter_max") = iter
                            );
  
}