//[[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;
}
//[[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);
}
}
////> 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
);
}