使用dplyr left_join为参数中的不同变量使用相同的数据集

时间:2017-07-23 21:45:43

标签: r dplyr

数据

我有驾驶模拟器实验的输出。我正在为2个不同的驾驶员改变车道分享一些数据。以下是第一个数据集foo

数据集#1

> foo
# A tibble: 4 x 7
                file.ID   lcf         TL lead_veh_TL foll_veh_TL Start_Frame_CS End_Frame1_CS
                  <chr> <int>      <chr>       <chr>       <chr>          <dbl>         <dbl>
1 Cars_20160601_01.hdf5 43207 right_lane      StarT7        <NA>          42899         43476
2 Cars_20160601_01.hdf5 43207 right_lane        <NA> ditiExpeon6          42899         43476
3 Cars_20160601_02.hdf5 52843  left_lane      BMWC10        <NA>          52498         53211
4 Cars_20160601_02.hdf5 52843  left_lane        <NA>    owT8Yell          52498         53211  

其中,
* file.ID =驾驶场景的唯一ID
* lcf =车辆触摸车道标记时的时间帧# * TL =目标车道(车道在车道变换结束时行驶的地方)
* lead_veh_TL =目标车道中的主要车辆名称
* foll_veh_TL =目标车道中跟随车辆的名称
* Start_Frame_CS =当车道变换在原始车道上开始时的时间帧# * End_Frame1_CS =车道变更在目标车道结束时的时间范围

以下是file.ID=="Cars_20160601_01.hdf5"情景的说明:
enter image description here

数据集#2

第二个数据框始终包括所有车辆的速度(包括车道变换发生的时间)。以下几行:

> bar
# A tibble: 205,231 x 5
                 file.ID frames      lane ADO_name speed.kph
                   <chr>  <int>     <chr>    <chr>     <dbl>
 1 Cars_20160601_01.hdf5  35002 left_lane   BMWC10  80.62273
 2 Cars_20160601_01.hdf5  35003 left_lane   BMWC10  80.72590
 3 Cars_20160601_01.hdf5  35004 left_lane   BMWC10  80.83455
 4 Cars_20160601_01.hdf5  35005 left_lane   BMWC10  80.94342
 5 Cars_20160601_01.hdf5  35006 left_lane   BMWC10  81.05671
 6 Cars_20160601_01.hdf5  35007 left_lane   BMWC10  81.17065
 7 Cars_20160601_01.hdf5  35008 left_lane   BMWC10  81.28705
 8 Cars_20160601_01.hdf5  35009 left_lane   BMWC10  81.40385
 9 Cars_20160601_01.hdf5  35010 left_lane   BMWC10  81.52023
10 Cars_20160601_01.hdf5  35011 left_lane   BMWC10  81.63548
# ... with 205,221 more rows  

其中, * frames =时间范围#
* lane =当前车道
* ADO_name =车辆名称(包括目标车道中的引导车辆和跟随车辆)
* speed.kph =当前时间内车辆的速度frames

bar数据集不足以在此完全重现,因为它包含变道和非变道时间帧。这个问题也需要它们。所以,我已在Google云端硬盘上传了bar。您可以在此处下载:https://drive.google.com/open?id=0ByvW4Hq_6a56dnIxYWh6M2ZRTUE(csv文件)

加载csv文件bar的代码:

library(tibble)
bar <- as_tibble(read.csv("bar.csv", header=TRUE))

我想做什么

我想将barfoo数据集用于:
1.在车道更换的开始框架(Start_Frame_CS)中提取铅和跟随车辆的速度 2.在LANE CHANGE FRAME(lcf)上提取铅和跟随车辆的速度
3.在LANE CHANGE(End_Frame1_CS)的END FRAME处提取铅和跟随车辆的速度
4.在车道变换期间提取铅的平均速度和跟随车辆,即包括Start_Frame_CSEnd_Frame1_CS之间的所有速度的平均值

我尝试了什么

我可以多次使用dplyr::left_join手动执行此操作。以下是我如何在lead_veh_TLlcf处提取Start_Frame_CS的速度。 library(dplyr) lead_veh_TL_lcf <- foo %>% select(-ends_with("CS"), -foll_veh_TL) %>% left_join(x=., y = bar, by = c("file.ID"="file.ID","lcf"="frames", "TL" = "lane", "lead_veh_TL" = "ADO_name") )%>% filter(!(is.na(lead_veh_TL)==TRUE)) %>% rename(speed.kph_LV_TL_lcf = speed.kph) > lead_veh_TL_lcf # A tibble: 2 x 5 file.ID lcf TL lead_veh_TL speed.kph_LV_TL_lcf <chr> <int> <chr> <chr> <dbl> 1 Cars_20160601_01.hdf5 43207 right_lane StarT7 79.54961 2 Cars_20160601_02.hdf5 52843 left_lane BMWC10 103.71717

车道变换框架中的引导车速

lead_veh_TL_SF <- foo %>% 
  select(-lcf, -foll_veh_TL, -End_Frame1_CS) %>% 
  left_join(x=., y = bar,
            by = c("file.ID"="file.ID","Start_Frame_CS"="frames", 
                   "TL" = "lane", "lead_veh_TL" = "ADO_name") )%>% 
  filter(!(is.na(lead_veh_TL)==TRUE)) %>% 
  rename(speed.kph_LV_TL_SF = speed.kph)  

> lead_veh_TL_SF
# A tibble: 2 x 5
                file.ID         TL lead_veh_TL Start_Frame_CS speed.kph_LV_TL_SF
                  <chr>      <chr>       <chr>          <dbl>              <dbl>
1 Cars_20160601_01.hdf5 right_lane      StarT7          42899           79.54841
2 Cars_20160601_02.hdf5  left_lane      BMWC10          52498          102.87223   

起始帧的引导速度

foo_mean_LV <- bar %>%
  left_join(x =., y = foo %>% select(-lcf,  -foll_veh_TL), 
            by = c("file.ID" = "file.ID")) %>% 
  group_by(file.ID) %>% 
  filter(frames>=Start_Frame_CS & frames<=End_Frame1_CS, ADO_name==lead_veh_TL) %>% 
  ungroup() %>% 
  group_by(file.ID, lead_veh_TL) %>% 
  summarize(Start_Frame_CS = unique(Start_Frame_CS),
            End_Frame1_CS = unique(End_Frame1_CS),
            mean_sp_LV = mean(speed.kph),
            sd_sp_LV = sd(speed.kph)) %>% 
  ungroup()

> foo_mean_LV
# A tibble: 2 x 6
                file.ID lead_veh_TL Start_Frame_CS End_Frame1_CS mean_sp_LV    sd_sp_LV
                  <chr>       <chr>          <dbl>         <dbl>      <dbl>       <dbl>
1 Cars_20160601_01.hdf5      StarT7          42899         43476   79.54532 0.006486832
2 Cars_20160601_02.hdf5      BMWC10          52498         53211  100.94923 1.608811109  

牵引车的平均速度

lead_veh_TL

对于以下车辆,我只需将上述代码中的foll_veh_TL替换为speed.kph

问题

正如您所看到的,以这种方式重复编写代码既繁琐又容易出错。我想使用一个功能,我可以提供时间范围和车辆类型(领先/跟随),其他一切都保持不变。但是,我似乎无法找到一种方法来编写这样的函数。我只找到了一个相关答案here。但这并不能解决我的问题。

请指导我如何编写有效的功能以获得所需的结果。我的原始数据集包含更多变量以及"<div><br><br></div><br><br><br><div><br></div><br>".gsub(/(<br>){2,}/, '<br>') 变量

0 个答案:

没有答案