R语言 使用mutate函数改进循环

ktca8awb  于 2023-04-18  发布在  其他
关注(0)|答案(2)|浏览(163)

我有一个名为result的 Dataframe ,看起来像这样。
| 后来|液化天然气|夜|
| --------------|--------------|--------------|
| 41.60701|1.000831|2019-06-19 2019-06-19|
| 41.98151|一九七三零五九|2020-04-11 2020-04-11 2020-04-11|
| ……|……|……|
基本上,我会添加4列。一列是日落的时间,第二列是日出的时间,第三列是以小时为单位的夜间持续时间,最后第四列是采样工作(我只是将时间buff添加到夜间持续时间)。我通过使用以下代码中的一个循环来做到这一点(unsing suncalc包用于getSunlightTimes)。

library("plyr")
library("dplyr")
library("reshape")
library("data.table")
library("stringr")
library("tidyr")
library("ineq")
library("suncalc")

library(suncalc)
time_buff <- 0.30
posta <- ls()
sorti <- ls()
night_hours <- ls()
temp <- result
for (i in 1:dim(temp)[1]) {
  lat <- temp$lat[i]
  long <- temp$lng[i]
  sset <- as.Date(temp$Night[i])
  sris <- sset + 1
  Tsset <- getSunlightTimes(sset, lat, long,
    keep = c("sunrise", "sunset"), tz = "UTC"
  )$sunset
  Tsris <- getSunlightTimes(sris, lat, long,
    keep = c("sunrise", "sunset"), tz = "UTC"
  )$sunrise
  posta[i] <- Tsset
  sorti[i] <- Tsris
  night_hours[i] <- round(as.numeric(Tsris - Tsset), 2)
}

# fetch results
temp$sun_set <- as.POSIXct(as.numeric(unlist(posta)),
  origin = "1970-01-01", tz = "UTC"
)
temp$sun_rise <- as.POSIXct(as.numeric(unlist(sorti)),
  origin = "1970-01-01", tz = "UTC"
)
temp$night_hours <- as.numeric(unlist(night_hours))
temp$night_effort <- as.numeric(temp$night_hours) + (time_buff * 2)

result <- temp

但是它需要很长的时间来运行。所以,我想知道是否有其他最简单的方法来做到这一点,例如使用dplyr包中的mutate函数而不是使用循环?

dwbf0jvd

dwbf0jvd1#

基本的计算可以用rowwise在tidyverse中完成-即getSunlightTimes对于latlong没有矢量化,所以我们一次只能提供一个值。如果'lat','long',而不是rowwise有重复,最好先做group_by(lat, lng),然后使用first(lat)getSunlightTimes调用中的first(lng)

library(dplyr)
data %>%
  rowwise %>%
  mutate(sset = as.Date(Night),  sris = sset + 1) %>% 
  mutate(Tsset = getSunlightTimes(sset, lat, lng,  keep ="sunset",
   tz = "UTC")$sunset,
  Tsris = getSunlightTimes(sris, lat, lng,  keep ="sunrise", 
   tz = "UTC")$sunrise) %>%
 ungroup
  • 输出
# A tibble: 2 × 7
    lat   lng Night      sset       sris       Tsset               Tsris              
  <dbl> <dbl> <chr>      <date>     <date>     <dttm>              <dttm>             
1  41.6  1.00 2019-06-19 2019-06-19 2019-06-20 2019-06-19 19:34:19 2019-06-20 04:22:55
2  42.0  1.97 2020-04-11 2020-04-11 2020-04-12 2020-04-11 18:29:30 2020-04-12 05:17:10

数据

data <- structure(list(lat = c(41.60701, 41.98151), lng = c(1.000831, 
1.973059), Night = c("2019-06-19", "2020-04-11")), class = "data.frame", row.names = c(NA, 
-2L))
m3eecexj

m3eecexj2#

更新:

我们不需要使用group_byrowwise。如果我们有多个坐标,阅读?getSunlightTimes告诉我们使用data作为替代:
date:日期。单个或多个日期。YYYY-MM-DD
纬度:数值。单纬度
lon:数字。单经度
data:data. frame。使用date、lat、lon传递多个坐标的替代方法
keep:字符。要保留的变量的向量。查看详细信息
tz:〉character.结果的时区
所以我们可以将数据框作为一个整体传递给函数,但是需要为列指定正确的名称。

result %>% 
  mutate(night = as.Date(night)) %>% 
  mutate(sunset = getSunlightTimes(data = transmute(., 
                                          date = night, lat = lat, lon = long), 
                                   keep = "sunset")$sunset,
         sunrise = getSunlightTimes(data = transmute(., 
                                           date = night + 1, lat = lat, lon = long), 
                                    keep = "sunrise")$sunrise,
         night_hr = as.numeric(round(difftime(sunrise, sunset, units = "hour"), 2)),
         night_effort = night_hr + (time_buff * 2))

#> # A tibble: 2 x 7
#>     lat   long night      sunset              sunrise             night_hr night_effort
#>   <dbl>  <dbl> <date>     <dttm>              <dttm>                 <dbl>        <dbl>
#> 1  40.0  -75.2 2023-04-13 2023-04-13 23:37:13 2023-04-14 10:25:55     10.8         11.4
#> 2  34.1 -118.  2023-04-01 2023-04-02 02:14:19 2023-04-02 13:40:21     11.4         12.0

我们可以使用rowwise代替循环,或者更好的方法是group_by(lat, long),并且只为每个组传递第一个lat和long。

library(lubridate)
library(dplyr)
library(suncalc)

result <- data.frame(lat = c(39.9526,34.0522), 
                     long = c(-75.1652, -118.243), 
                     night = c(mdy("4/13/2023"),mdy("4/01/2023")))
time_buff <- 0.3

result %>% 
  group_by(lat, long) %>% 
  mutate(sunset = getSunlightTimes(as.Date(night), lat[1], long[1])$sunset,
         sunrise = getSunlightTimes(as.Date(night) + 1, lat[1], long[1])$sunrise,
         night_hr = as.numeric(round(difftime(sunrise, sunset, units = "hour"), 2)),
         night_effort = night_hr + (time_buff * 2)) %>% 
  ungroup()

#> # A tibble: 2 x 7
#>     lat   long night      sunset              sunrise             night_hr night_effort
#>   <dbl>  <dbl> <date>     <dttm>              <dttm>                 <dbl>        <dbl>
#> 1  40.0  -75.2 2023-04-13 2023-04-13 23:37:13 2023-04-14 10:25:55     10.8         11.4
#> 2  34.1 -118.  2023-04-01 2023-04-02 02:14:19 2023-04-02 13:40:21     11.4         12.0

相关问题