Я читал об этом здесь: https://en.wikipedia.org/wiki/Valeriepieris_circle . Это задача, задача которой состоит в том, чтобы найти наименьший возможный круг, в котором проживает половина населения мира. Я пытаюсь повторить эту задачу самостоятельно в качестве учебного упражнения.

Для начала вместо использования реальной карты мира — для упрощения — я представил себе прямоугольный мир. Этот прямоугольный мир на самом деле представляет собой сетевой граф, состоящий из 1000 узлов, так что каждый узел соединен со всеми своими непосредственными соседями только один раз. Узлы графа имеют идентификаторы от 1 до 1000, и каждому узлу присваивается случайное значение, представляющее популяцию в этой точке.

Вот как все выглядит:

library(igraph)

width <- 30
height <- 20
num_nodes <- width * height

# Create a grid
x <- rep(1:width, each = height)
y <- rep(1:height, times = width)

g <- make_empty_graph(n = num_nodes, directed = FALSE)

# Function to get node index
get_node_index <- function(i, j) (i - 1) * height + j

# Add edges
edges <- c()
for(i in 1:width) {
   for(j in 1:height) {
      current_node <- get_node_index(i, j)
    
      # Connect to right neighbor
      if (i < width) edges <- c(edges, current_node, get_node_index(i + 1, j))
    
      # Connect to bottom neighbor
      if (j < height) edges <- c(edges, current_node, get_node_index(i, j + 1))
   }
}

g <- add_edges(g, edges)

V(g)$x <- x
V(g)$y <- y

par(mfrow=c(1,2))

V(g)$name <- 1:num_nodes
plot(g, vertex.size = 7, vertex.label = V(g)$name, vertex.label.cex = 0.6, main = "Map with         Node Indices")

V(g)$value <- sample(1:100, num_nodes, replace = TRUE)
plot(g, vertex.size = 7, vertex.label = V(g)$value, vertex.label.cex = 0.6, main = "Map with     Population Values")

С кругами работать довольно сложно. Вместо кругов я решил работать с квадратами, состоящими из 4 узлов. Моя задача теперь — найти квадрат с наибольшей суммой узлов. Я попытался составить исчерпывающий список всех квадратов и записать их суммы:

library(dplyr)
squares <- list()
square_id <- 1

for(i in 1:(width-1)) {
for(j in 1:(height-1)) {
    top_left <- get_node_index(i, j)
    top_right <- get_node_index(i+1, j)
    bottom_left <- get_node_index(i, j+1)
    bottom_right <- get_node_index(i+1, j+1)
    
        square <- c(top_left, top_right, bottom_left, bottom_right)
        squares[[square_id]] <- square
        square_id <- square_id + 1
    }
}

result_df <- data.frame(
    square_id = seq_along(squares),
    nodes_id_selected = sapply(squares, function(s) paste(s, collapse = ", ")),
    value = sapply(squares, function(s) sum(V(g)$value[s]))
)

print(head(result_df %>% arrange(-value)))

 square_id  nodes_id_selected value
       334 351, 371, 352, 372   365
        51     53, 73, 54, 74   350

Вопрос

Есть ли способ обобщить этот подход для любой двусторонней формы? например треугольник, шестиугольник и т. д. Можно ли написать функцию, которая сможет выполнять эти сравнения для любой двусторонней фигуры?