#' 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;
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.