循环:计数匹配和两个数据之间的唯一元素，并将函数应用于计数。

Question

我想进行一个非常复杂的循环。我有多个区域，每个区域在我的实际数据框架中都有数百个地块。我想要子集的区域，然后绘制和预先形成各种功能在子集上，最终计算不同的欠下的只有物种是共享的。我首先要说的是，每一行都代表着一种相互作用。

我的例子df：

 set.seed(540)
 df<- data.frame(region= c(rep(1, 16), rep(2,8)), 
            plot= c(rep("A",5), rep("B",9), rep("C", 2), rep("D", 6),rep("E", 2)), 
            plantsp= sample(1:24,24, replace= TRUE), 
            lepsp= sample(1:24,24,replace= TRUE), 
            psitsp= sample(1:24,24,replace= TRUE))
 df[] <- lapply(df, as.character)
 df$plantsp<-paste('plantsp', df$plantsp, sep='_')
 df$lepsp<-paste('lepsp', df$lepsp, sep='_')
 df$psitsp<-paste('psitsp', df$psitsp, sep='_')
 df$paste1<- paste(df$plantsp, df$lepsp, sep='_')
 df$paste2<- paste(df$lepsp, df$psitsp, sep='_')
 df$paste3<- paste(df$plantsp,df$lepsp, df$psitsp)

Step1:按区域划分的子集df。示例：

region_sub <- split(df, df$region)

Step2:按图划分的df子集。示例：

plot_sub <- split(region_sub[[1]], region_sub[[1]][[2]])

Step3:我们将调用上面步骤中的每个子集(每个列表组件)为一个绘图子集。在本例中，我将使用第一个子集(region1，plotA)作为所有后续输出的示例。我将此称为region1，plotA子集plot_sub1。我想将plot_sub1与原始的df进行比较，生成三个df子集。我们称之为df_sub1，df_sub2，df_sub3。首先，df_sub1由plantsp中的条目之间的匹配、plot_sub1和df中的lepsp列组成。删除具有任何唯一条目的行以及与plantsp匹配的行，但不移除lepsp和visa匹配的行。df_sub1的例子：

df_sub1<- df[c(1,2,3,4,5,22),c(1:4,6)] 

请注意，只有那些具有共享物种的行仍然存在。此外，只有那些与共有物种也相互作用的行仍然存在。此外，我还删除了不必要的列(例如psitsp、paste2、paste3)，以提请您注意这一步骤的结果。代码不需要删除这些列。

Step4:对lepsp和psitsp列重复step3以生成df_sub2。示例：

df_sub2<- df[1:5,c(1:2,4,5,7)] 

Step5:对plantsp、lepsp和psitsp列重复step3以生成df_sub3。示例：

df_sub3<- df[1:5,c(1:5,8)] 

Step6:现在所有子集都已生成，我希望在paste1列中计算plot_sub1和df_sub1 (=5)中的匹配元素。示例:这将存储在向量match中。相应地，结果将存储在匹配或唯一向量中。示例：

match<- length(intersect(df_sub1$paste1,  plot_sub[[1]]$paste1))
match

我还想计算唯一的元素(=1)。这将存储在向量unique中。plot_sub1和df_sub2以及plot_sub1和df_sub3都会重复这种情况。我不知道如何计算两个df中的唯一元素，因此我不能提供示例代码。

 unique<- 1

注意:在plot_sub重复交互或匹配的情况下，df_sub之间的匹配只需要计算1次。这需要解释存在--没有火柴，而不是充足的火柴。

概括地说，这两个向量是：

match<- c( length(intersect(df_sub1$paste1,  plot_sub[[1]]$paste1)),  
length(intersect(df_sub2$paste2,  plot_sub[[1]]$paste2)),  
length(intersect(df_sub3$paste3,  plot_sub[[1]]$paste3))

match

unique<-c(1,0,0)

然后将每个向量的和加在一起。示例：

sum_match<- 15
sum_unique<- 1

Step7:最后，这些值将输入到一个函数中：((a + b)/((2*a + b)/2) - 1)，其中a= sum_match和b=sum_unique。然后将该值输入结果向量res_vec。

Step8:这个过程(第3-7步)将对每个绘图子集进行迭代。

有效地，这将计算不同的共享交互之间的情节相互作用和相应的元网(所有可能的互动)。这是对(Poisot等人，2012年)的修改，以解释三重相互作用。

这很可悲，但是要开始for循环，我有：

res_vec<- NA

for (i in 1:length(unique(df$region)))
  {
      for (j in 1:length(unique(df$plot)))
     {

我真的很感激任何时候有人愿意帮助我实现循环中的论点。这对我来说很棘手。

Answer 1

Thans @Gregor感谢你在评论中所做的所有澄清！

下面是我使用tidyverse的解决方案。

代码+解释

## Load packages
library(tidyverse)

## Nest data
new_df <- df %>% 
  group_by(region, plot) %>% 
  nest(.key = plot_sub) 

new_df

# A tibble: 5 x 3
#     region   plot         plot_sub
#      <dbl> <fctr>           <list>
#   1      1      A <tibble [5 x 3]>
#   2      1      B <tibble [9 x 3]>
#   3      1      C <tibble [2 x 3]>
#   4      2      D <tibble [6 x 3]>
#   5      2      E <tibble [2 x 3]>

列plot_sub与问题中同名的列表包含相同的数据。将此列看作是数据格式的列表。

我知道编写一个函数来创建df_sub。这使我们的代码更加清晰，避免了不必要的重复。然后这个函数将应用到我们的列plot_sub。

# Function to create the df_sub
# Takes the plot_sub, original dataframe (df) and a list of columns, which should be compared
# Returns the desired df_sub with new interactions of species which are in plot_sub
# Only unique interactions are returned

create_df_sub <-  function(plot_sub, df, col_list){
  # Filter df such that it only contains species which are in plot_sub
  for (x in col_list) {
    df <- df[df[[x]] %in% plot_sub[[x]], ]
  }

  # Combine plot_sub and filtered df
  df_sub <- rbind(plot_sub[, col_list], df[, col_list]) 
  # Paste relevant colums together
  df_sub$paste_col <- do.call(paste, c(df_sub[, col_list], sep = '_'))
  # Exclude duplicated values
  df_sub <- df_sub[!duplicated(df_sub$paste_col), ]

  return(df_sub)
}

现在，我定义了要创建df_sub的列，然后将函数应用到plot_sub-column

col_list1 <- c('plantsp', 'lepsp')
col_list2 <- c('lepsp', 'psitsp')
col_list3 <- c('plantsp', 'lepsp', 'psitsp')

new_df <- new_df %>% 
  mutate(df_sub1 = map(plot_sub, create_df_sub, df = df, col_list = col_list1), 
         df_sub2 = map(plot_sub, create_df_sub, df = df, col_list = col_list2), 
         df_sub3 = map(plot_sub, create_df_sub, df = df, col_list = col_list3)) 

map以向量或列表作为参数，并将指定的函数应用于每个元素(如lapply)。比较df_sub1和plot_sub的第一个元素以了解差异。

new_df$plot_sub[[1]]
# A tibble: 5 x 3
#      plantsp    lepsp    psitsp
#        <chr>    <chr>     <chr>
# 1  plantsp_2 lepsp_19 psitsp_19
# 2 plantsp_21 lepsp_19  psitsp_4
# 3 plantsp_19  lepsp_2 psitsp_11
# 4  plantsp_9 lepsp_13 psitsp_24
# 5 plantsp_24  lepsp_9  psitsp_2

new_df$df_sub1[[1]]
# A tibble: 6 x 3
#      plantsp    lepsp           paste_col
#        <chr>    <chr>               <chr>
# 1  plantsp_2 lepsp_19  plantsp_2_lepsp_19
# 2 plantsp_21 lepsp_19 plantsp_21_lepsp_19
# 3 plantsp_19  lepsp_2  plantsp_19_lepsp_2
# 4  plantsp_9 lepsp_13  plantsp_9_lepsp_13
# 5 plantsp_24  lepsp_9  plantsp_24_lepsp_9
# 6  plantsp_9  lepsp_2   plantsp_9_lepsp_2

新的交互是在df_sub1中添加的。

为了提取匹配值和唯一值，我在inner_join -column和不同的df_sub上使用了plot_sub和-column。

new_df <- new_df %>%
  mutate(match1 = map2(df_sub1, plot_sub, inner_join, by = col_list1), 
         match2 = map2(df_sub2, plot_sub, inner_join, by = col_list2), 
         match3 = map2(df_sub3, plot_sub, inner_join, by = col_list3), 
         unique1 = map2(df_sub1, plot_sub, anti_join, by = col_list1), 
         unique2 = map2(df_sub2, plot_sub, anti_join, by = col_list2), 
         unique3 = map2(df_sub3, plot_sub, anti_join, by = col_list3)) 

inner_join返回在by-argument中指定的列中具有匹配值的所有行，而anti_join返回所有不匹配的df_sub行。这里我使用map2-function，它接受两个向量/列表并应用指定的函数。

new_df$match1[[1]]
# A tibble: 5 x 4
#      plantsp    lepsp    psitsp           paste_col
#        <chr>    <chr>     <chr>               <chr>
# 1  plantsp_2 lepsp_19 psitsp_19  plantsp_2_lepsp_19
# 2 plantsp_21 lepsp_19  psitsp_4 plantsp_21_lepsp_19
# 3 plantsp_19  lepsp_2 psitsp_11  plantsp_19_lepsp_2
# 4  plantsp_9 lepsp_13 psitsp_24  plantsp_9_lepsp_13
# 5 plantsp_24  lepsp_9  psitsp_2  plantsp_24_lepsp_9

new_df$unique1[[1]]
# A tibble: 1 x 3
#     plantsp   lepsp         paste_col
#       <chr>   <chr>             <chr>
# 1 plantsp_9 lepsp_2 plantsp_9_lepsp_2

在最后一步中，我提取每个match和unique的行数，并将其加起来。我还计算了res_vec。

new_df <- new_df %>%
  mutate(sum_match = map_int(match1, nrow) + map_int(match2, nrow) + map_int(match3, nrow), 
         sum_unique = map_int(unique1, nrow) + map_int(unique2, nrow) + map_int(unique3, nrow), 
         res_vec = ((sum_match + sum_unique)/((2*sum_match + sum_unique)/2)) - 1)

在这里，我使用map_int作为返回值是一个整数，我想直接使用它的和。使用map只会返回一个列表，我首先必须将其转换为整数向量。

new_df %>% select(region, plot, sum_match, sum_unique, res_vec)
# A tibble: 5 x 5
#   region   plot sum_match sum_unique    res_vec
#    <dbl> <fctr>     <int>      <int>      <dbl>
# 1      1      A        15          1 0.03225806
# 2      1      B        27          3 0.05263158
# 3      1      C         6          2 0.14285714
# 4      2      D        18          1 0.02702703
# 5      2      E         6          0 0.00000000

数据

set.seed(540)
df <- data.frame(region = c(rep(1, 16), rep(2, 8)), 
                plot = c(rep('A', 5), rep('B', 9), rep('C', 2), rep('D', 6),rep('E', 2)), 
                plantsp = sample(1:24, 24, replace = TRUE), 
                lepsp = sample(1:24, 24, replace = TRUE), 
                psitsp = sample(1:24, 24, replace = TRUE))
df$plantsp <- paste('plantsp', df$plantsp, sep = '_')
df$lepsp <- paste('lepsp', df$lepsp, sep = '_')
df$psitsp <- paste('psitsp', df$psitsp, sep = '_')