编写一个函数,该函数获取数据框的每一行,并根据该行的特征创建一个单独的数据框

时间:2018-04-08 18:56:38

标签: r function matrix apply

我正在观察从一个地方到另一个地方的过渡。我将简化我的问题,使我更清楚我想要做的事情。

假设一个人可以去3个地方:A,B,C。

我目前有一个数据帧,可以捕获从一个地方到另一个地方的转换(允许顺序转换可以到达同一个地方;例如,A到A)。

Origin Dest Time 
     A    B  Mon
     B    C  Wed
     C    B  Fri

我还创建了一个距离矩阵,可以捕捉从一个地方到另一个地方的距离。

   A  B  C
A  0  8 11
B  8  0  6
C 11  6  0

我也有一个人气和#34;数据框,捕获任何人在一段时间之前到达A,B,C的总次数。

  Popularity
B         47
C         32
A         25

我要做的是创建一个数据框(针对每次转换),每一行都是一个可能的目的地,该人可以根据是否使用编码为0或1的目标变量进行操作。那个人居然去了那个目的地。换句话说,上述转换数据帧(星期一A到B)中第一次转换的数据帧应为:

 Origin  Dest  Went?  Dist  Time_Dest  Pop
      A     A      0     0      Mon_A   25
      A     B      1     8      Mon_B   47
      A     C      0    11      Mon_C   32

我想迭代这个,为每个转换(转换数据帧中的每一行)创建一个不同的数据帧,然后将所有这些数据帧附加在一起以创建一个大数据帧,这将允许我运行一个大规模的逻辑给定起源和时间的回归以预测下一个目的地的概率。

有人可能会提供有关如何编写函数的任何见解吗?或者也许有一种更简单的方法?

非常感谢您的帮助。

1 个答案:

答案 0 :(得分:1)

大部分内容都可以通过一些合并语句来完成。我使用tidyverse套件来完成工作,但您可以很容易地在基础R中执行此操作。我将指出更改 - 但最大的将是使用临时变量或嵌套而不是管道。管道命令%>%只是调用链中的下一个函数,前一个结果作为第一个参数。

library(tidyverse)

# generating your data
locations <- LETTERS[1:3]
n_locations <- length(locations)

# using base R, use the function expand.grid instead of crossing
location_combinations <- crossing(Origin = locations, Dest = locations)

dist_matrix <- matrix(0,nrow = n_locations, ncol = n_locations)
dist_matrix[lower.tri(dist_matrix)] <- c(8, 11, 6)
dist_matrix <- dist_matrix + t(dist_matrix)

transitions <- data_frame(
  Origin = locations,
  Dest = locations[c(2,3,2)],
  Time = c("Mon", "Wed", "Fri")
)

# Make "Dest" a vector instead of the rownames to work with it a little more easily.
popularity <- data_frame(
  Dest = locations,
  Popularity = as.integer(c(25, 47, 32))
)

# left_join can be replaced with "merge" using base R.  
# mutate can be replaced by defining/redefining each variable separately, or using the "within" command.   
tmp <- location_combinations %>%
  left_join(transitions, by = c("Origin", "Dest")) %>%
  left_join(popularity, by = "Dest") %>%
  mutate(
    Origin = as_factor(Origin),
    Dest = as_factor(Dest),
    `Went?` = !is.na(Time),
    Time_Dest = paste(Time, Dest, sep = "_"),
    index = (as.numeric(Origin)-1) * n_locations + as.numeric(Dest),
    Dist = dist_matrix[(as.numeric(Origin)-1) * length(locations) + as.numeric(Dest)]
  ) %>%
  select(-Time)
tmp

这几乎可以满足您的需求。两个不同之处 - 首先,我将Went?作为逻辑向量而不是1/0。如果需要进行逻辑回归,则乘以1来解决此问题。另一个区别是&#34; Time_Dest&#34;列,没有关于没有发生的事件的日期。换句话说,&#34;而不是&#34; Mon_A&#34;对于A到A,它会看到&#34; NA_A&#34;。如果这是一个大问题,我几乎可以肯定通过另一个合并/加入来解决这个问题,所以如果你需要它,请告诉我并且无法弄明白。 (提示 - 与Transitions数据框进行第二次合并,但使用by = origin)。

要查看部分工作(并且更好地了解管道,您可以运行此代码的部分。例如,尝试

location_combinations %>%
  left_join(transitions, by = c("Origin", "Dest"))

好的,现在你(或多或少)将整个数据集放在一个位置。要拆分它,有几种选择。

  1. 您可以使用split将其拆分为Origin。代码看起来像

    list_of_dfs <- split(tmp, tmp$Origin)
    

    这完全符合您的要求,可以单独分析数据框列表。

  2. 您可以在group_by包中使用dplyr函数(tidyverse的一部分。)使用此方法的示例位于Linear Regression and group by in R。这里需要注意的是do函数将被折旧,因此这不是一个永远有效的解决方案。我最近还没需要它,所以我不确定&#34; new&#34;解决方案是,但是,结合broom包几乎可以帮助您组织结果。 (见https://cran.r-project.org/web/packages/broom/vignettes/broom_and_dplyr.html)。
  3. 更新以包含所有可能的目的地

    location_combinations %>%
      left_join(transitions, by = c("Origin", "Dest")) %>%
      left_join(transitions %>% select(Origin, Time), by = "Origin") %>%
      left_join(popularity, by = "Dest") %>%
      mutate(
        Origin = as_factor(Origin),
        Dest = as_factor(Dest),
        `Went?` = !is.na(Time.x),
        Time_Dest = paste(Time.y, Dest, sep = "_"),
        index = (as.numeric(Origin)-1) * n_locations + as.numeric(Dest),
        Dist = dist_matrix[(as.numeric(Origin)-1) * length(locations) + as.numeric(Dest)]
      ) %>%
      select(-Time.x, -Time.y, -index)