Comment générer des données où les points sont «repoussés» s'ils atterrissent à une certaine proximité d'un autre point?

Vous pouvez écrire votre propre fonction pour ce faire. Il prend trois arguments: le nombre de points que vous voulez, le rayon du cercle contenant et la distance minimale entre les points.

Il commence simplement avec deux vecteurs vides pour x et y, puis génère une paire aléatoire x, y tirée de la distribution uniforme. Si cette paire x, y est à l'extérieur du cercle unitaire ou à une distance donnée d'un point existant, elle est rejetée et une autre paire est dessinée. Sinon, le point est conservé. Ce processus est répété jusqu'à ce que les vecteurs x et y soient pleins. À ce stade, un bloc de données est créé à partir des valeurs x et y multipliées par le rayon de cercle souhaité pour générer le résultat.

S'il ne trouve aucun endroit pour mettre un nouveau point après avoir essayé un grand nombre de fois, il lancera une erreur. L'exemple donné de 210 points ne conviendra que si la distance minimale est de 0,1:

dots <- repelled_points(210, 1, 0.1)
plot(dots, type="n")
points(dots$x[1:45], dots$y[1:45], pch=15, col="red", cex=2)
points(dots$x[46:90], dots$y[46:90], pch=15, col="red", cex=2)
points(dots$x[91:151], dots$y[91:151], pch=17, col="blue", cex=2)
points(dots$x[152:210], dots$y[152:210], pch=17, col="blue", cex=2)

Ce qui, lorsque vous exécutez votre code de traçage, renvoie le résultat suivant:

repelled_points <- function(n, r_circle, r_clash) {
  container_x <- numeric(n)
  container_y <- numeric(n)
  j <- i <- 1
  while(i <= n)
  {
    j <- j + 1
    if(j == 100 * n) stop("Cannot accommodate the points in given space")
    x <- runif(1, -1, 1)
    y <- runif(1, -1, 1)
    if(x^2 + y^2 > 1) next
    if(i > 1) {
     dist <- sqrt((x - container_x[seq(i-1)])^2 + (y - container_y[seq(i-1)])^2)
     if(any(dist < r_clash)) next
    }
    container_x[i] <- x
    container_y[i] <- y
    i <- i + 1
    j <- 1
  }
  `class<-`(list(window = disc(centre = c(0, 0), radius = r_circle),
       n = n, x = container_x * r_circle, 
       y = container_y * r_circle, markformat = "none"), "ppp")
}

Pas la solution la plus élégante, mais voici une approche

# sample_size = 3000
total_points = 210

find_repelled_dots <- function(total_points, radius = 1, min_distance = 0.1, max_iterations = 10000){
  
  # Initialize the first point
  selected_dots = runifdisc(1, radius=1)
  selected_dots = c(selected_dots$x, selected_dots$y)
  
  # Initialize iterators
  picked = 1
  i = 1
  
  while (picked < total_points & i < max_iterations) { # Either enough points or max iterations
    dots_sample = runifdisc(1, radius = radius) # Choose a data points
    selected_dots_temp = rbind(selected_dots, c(dots_sample$x, dots_sample$y)) # Find distance between existing points
    
    if (min(dist(selected_dots_temp)) > min_distance){ # If sufficiently far from all the other points, add to the mix, else try again
      picked = picked + 1 # Keep track of picked points
      selected_dots = selected_dots_temp # Update picked list
    }
    i = i + 1 # Keep track of iterations
  }
  if (i > 10000){
    stop("Max iterations passed! Increase number of iterations")
  }
  
  return(list(x = selected_dots[,1], y = selected_dots[,2]))
  
}

dots = find_repelled_dots(210)

plot(dots, type="n")
points(dots$x[1:45], dots$y[1:45], pch=15, col="red", cex=2)
points(dots$x[46:90], dots$y[46:90], pch=15, col="red", cex=2)
points(dots$x[91:151], dots$y[91:151], pch=17, col="blue", cex=2)
points(dots$x[152:210], dots$y[152:210], pch=17, col="blue", cex=2)

Il existe plusieurs fonctions dans spatstat pour simuler des points avec une distance minimale. Avec rHardcore() les points sont en un sens indépendants les uns des autres, mais le nombre de points est aléatoire. Avec rSSI() vous obtenez un nombre fixe de points (si possible avant que l'algorithme rSSI() ):

marks(X) <- sample(c(rep("a", 90), rep("b", 120)))
plot(X, main = "", cols = c("red", "blue"))

Vous pouvez attacher des marques au hasard aux points pour les faire tracer avec différents caractères:

library(spatstat)
X <- rSSI(0.1, 210, win = disc(1))

Ce n'est pas particulièrement rapide.

Il existe des fonctions dans spatstat pour ce faire, notamment rSSI , rMaternI , rMaternII , rHardcore , rStrauss et rmh . Cela dépend de la manière dont vous voulez que les points «arrivent» et de la manière dont ils doivent être «repoussés».

• rSSI : les points arrivent un par un. Chaque point est placé au hasard, sous réserve qu'il ne se trouve pas trop près d'un point existant. Le jeu s'arrête lorsqu'il est impossible de placer un nouveau point n'importe où ("simple inhibition séquentielle")
• rMaternI : les points arrivent tous en même temps. Ensuite, tout point qui se trouve trop près d'un autre point est supprimé. (Modèle d'inhibition de Matérn 1)
• rMaternII : les points arrivent à des moments aléatoires dans une certaine période de temps. Leurs heures d'arrivée sont enregistrées. A l'issue de cette période, tout point trop proche d'un autre, arrivé plus tôt , est supprimé. (Modèle d'inhibition de Matérn 2)
• rHardcore et rmh : les points continuent d'arriver, à des moments aléatoires, pour toujours. Un point nouvellement arrivé est rejeté et supprimé s'il se rapproche trop d'un point existant. Les points existants ont des durées de vie finies et sont supprimés à la fin de leur vie. Ce processus est exécuté pendant une longue période, puis un instantané est pris. (Processus du noyau dur de Gibbs simulé à l'aide d'un processus spatial de naissance et de mort).

Les fonctions de spatstat ont été complètement déboguées et testées, donc je recommanderais de les utiliser au lieu d'écrire un nouveau code, si possible.

Pour la documentation, voir Section 5.5 et Chapitre 13 du livre spatstat