代码之家 › 专栏 › 技术社区 › MoonS

基于两列的反向组合分配值

tile reverse insert matrix r

MoonS · 技术社区 · 2 年前

在这个问题之后, Multiple values in one tile with geom_tile 和矩阵图,我想在 agreement_num 为了对称,即对于反向配对组合,我想画出相同的图 协议_num 。我正在创建一个新问题,因为这需要找到配对的反向组合,分配相应的 协议_num 然后为每个组合插入新行,以及 协议_num 。例如,从哈萨克斯坦到吉尔吉斯斯坦有六排和六个独特的 协议_num 。预期的输出将是在数据帧中具有以下行:

from        to          weight          agreement_num
Kyrgyzstan  Kazakhstan  1.337996e+08    51
Kyrgyzstan  Kazakhstan  1.337996e+08    176
Kyrgyzstan  Kazakhstan  1.337996e+08    58
Kyrgyzstan  Kazakhstan  1.337996e+08    224
Kyrgyzstan  Kazakhstan  1.337996e+08    133
Kyrgyzstan  Kazakhstan  1.337996e+08    135

以便能够在矩阵图中为反向国家组合绘制相同的瓦片属性。

我已经成功地创建了下面的数据,但无法理解插入新行和分配 协议_num 对于每一行:

# Create empty vectors to store values
oneway <- logical(nrow(plot_data))
additional_value <- list()

# Iterate over each row of the data frame
for (i in 1:nrow(plot_data)) {
  # Find indices of reverse pairs
  reverse_indices <- which(plot_data$from == plot_data$to[i] & plot_data$to == plot_data$from[i] & seq_len(nrow(plot_data)) != i)
  
  # Assign the oneway value
  oneway[i] <- length(reverse_indices) > 0
  
  # Assign additional value based on reverse combination
  if (oneway[i]) {
    # Add the additional values from the "agreement_num" column of the reverse pairs
    additional_value[[i]] <- unique(plot_data$agreement_num[reverse_indices])
  } else {
    # Assign NA if oneway is FALSE
    additional_value[[i]] <- NA
  }
}

# Add the vectors as new columns to the data frame
plot_data$oneway <- oneway
plot_data$additional_value <- additional_value

可复制数据:

plot_data <- structure(list(from = structure(c(2L, 2L, 2L, 2L, 2L, 2L, 2L, 
2L, 2L, 2L, 2L, 2L, 2L, 2L, 3L, 3L), levels = c("Afghanistan", 
"Kazakhstan", "Kyrgyzstan", "Tajikistan", "Turkmenistan", "Uzbekistan"
), class = "factor"), to = structure(c(1L, 3L, 3L, 3L, 3L, 3L, 
3L, 4L, 4L, 4L, 5L, 5L, 6L, 6L, 2L, 6L), levels = c("Afghanistan", 
"Kazakhstan", "Kyrgyzstan", "Tajikistan", "Turkmenistan", "Uzbekistan"
), class = "factor"), weight = c(1291072130433.34, 480160896152.234, 
480160896152.234, 480160896152.234, 480160896152.234, 480160896152.234, 
480160896152.234, 3474907531417.02, 3474907531417.02, 3474907531417.02, 
867103764128.709, 867103764128.709, 7791981051421.92, 7791981051421.92, 
133799551.098735, 1102379004.66647), agreement_num = c(NA, 51L, 
176L, 58L, 224L, 133L, 135L, 58L, 51L, 224L, 51L, 224L, 51L, 
224L, NA, NA), com.x = c(2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 
2L, 2L, 2L, 2L, 2L, 2L, 2L), com.y = c(2L, 2L, 2L, 2L, 2L, 2L, 
2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L), cut = c(3, 1, 1, 1, 
1, 1, 1, 3, 3, 3, 3, 3, 4, 4, 1, 1), oneway = c(FALSE, TRUE, 
TRUE, TRUE, TRUE, TRUE, TRUE, FALSE, FALSE, FALSE, FALSE, FALSE, 
FALSE, FALSE, TRUE, FALSE), additional_value = list(NA, NA_integer_, 
    NA_integer_, NA_integer_, NA_integer_, NA_integer_, NA_integer_, 
    NA, NA, NA, NA, NA, NA, NA, c(51L, 176L, 58L, 224L, 133L, 
    135L), NA)), row.names = c(NA, -16L), class = "data.frame")

也许有一种更简单的方法可以做到这一点,很乐意得到建议。

添加打印代码:


# Set agreement_num as factor

plot_data$agreement_num <- as.factor(plot_data$agreement_num)

# Allow multiple tiles

plot_data <- plot_data |>
  mutate(
    x = as.numeric(from),
    y = as.numeric(to),
    ymin = y - .5, ymax = y + .5
  ) |>
  mutate(
    n = n(),
    xmin = x + scales::rescale(row_number(),
                               from = c(1, unique(n) + 1),
                               to = .5 * c(-1, 1)
    ),
    xmax = x + scales::rescale(row_number() + 1,
                               from = c(1, unique(n) + 1),
                               to = .5 * c(-1, 1)
    ),
    .by = c(from, to)
  )


# Create color palette

par(mar=c(0,0,1,0))

coul <- brewer.pal(9, "Set3") 

# Plot
ggplot(plot_data, aes(x = from, y = to, fill = agreement_num)) +
  geom_rect(
    aes(xmin = xmin, xmax = xmax, ymin = ymin, ymax = ymax)
  ) +
  scale_fill_manual(values = coul) +
  theme_bw() +
  scale_x_discrete(drop = FALSE) +
  scale_y_discrete(drop = FALSE) +
  labs(title = "Community 2") +
  theme(plot.title = element_text(size=17),
    axis.text.x = element_text(
      size = 12, angle = 270,
      hjust = 0, vjust = 0
    ),
    axis.text.y = element_text(size = 12),
    axis.title.x = element_text(size = 15),
    axis.title.y = element_text(size = 15),
    aspect.ratio = 1
  )

1 回复 | 直到 2 年前

r2evans 2 年前

如果您只需要反转名称,那么简单的行绑定如何?

dplyr

library(dplyr)
rename(plot_data, from = to, to = from) |>
  bind_rows(plot_data) |>
  filter(to == "Kyrgyzstan")
#           to       from       weight agreement_num com.x com.y cut oneway           additional_value
# 1 Kyrgyzstan Kazakhstan    133799551            NA     2     2   1   TRUE 51, 176, 58, 224, 133, 135
# 2 Kyrgyzstan Uzbekistan   1102379005            NA     2     2   1  FALSE                         NA
# 3 Kyrgyzstan Kazakhstan 480160896152            51     2     2   1   TRUE                         NA
# 4 Kyrgyzstan Kazakhstan 480160896152           176     2     2   1   TRUE                         NA
# 5 Kyrgyzstan Kazakhstan 480160896152            58     2     2   1   TRUE                         NA
# 6 Kyrgyzstan Kazakhstan 480160896152           224     2     2   1   TRUE                         NA
# 7 Kyrgyzstan Kazakhstan 480160896152           133     2     2   1   TRUE                         NA
# 8 Kyrgyzstan Kazakhstan 480160896152           135     2     2   1   TRUE                         NA

( filter ed只是为了表明你想要的六排在那里)

基本R

transform(plot_data, to = from, from = to) |>
  rbind(plot_data)