R/Slpm2.R

Defines functions Slpm2

Documented in Slpm2

#' Title
#'
#' @param pik
#' @param X
#' @param funzdist
#'
#' @return
#' @export
#'
#' @examples
Slpm2 <- function(pik,X,funzdist){
  N = length(pik);
  unfinished  = 1:N;
  while(length(unfinished) > 0){
    i = unfinished[floor(runif(1)*length(unfinished))+1];
    rand = runif(1);
    if(length(unfinished) > 1){
      mindist = Inf;
      nearest = c();
      others = unfinished[unfinished!=i];
      for(j in others){
        dist = funzdist(X[j,],X[i,]);
        if(dist == mindist){
          nearest = c(nearest,j);
        }
        if(dist < mindist){
          mindist = dist;
          nearest = c(j);
        }
      }
      j = nearest[floor(runif(1)*length(nearest))+1];
      if(pik[i]+pik[j]<1){
        if( rand < pik[i]/(pik[i]+pik[j]) ){
          pik[i] = pik[i]+pik[j];
          pik[j] = 0;
        }else{
          pik[j] = pik[i]+pik[j];
          pik[i] = 0;
        }
      }else{
        if( rand < (1-pik[j])/(2-pik[i]-pik[j])){
          pik[j] = pik[i]+pik[j]-1;
          pik[i] = 1;
        }else{
          pik[i] = pik[i]+pik[j]-1;
          pik[j] = 1;
        }
      }
      if(pik[i]==0|pik[i]==1){unfinished = unfinished[unfinished!=i];}
      if(pik[j]==0|pik[j]==1){unfinished = unfinished[unfinished!=j];}
    }else{
      if( rand < pik[i] ){
        pik[i] = 1;
      }else{
        pik[i] = 0;
      }
      unfinished = unfinished[unfinished!=i];
    }
  }
  pik;
}
vincnardelli/crowdpostsampler documentation built on May 25, 2019, 7:23 p.m.