Улучшите цикл, используя функцию mutate
У меня есть фрейм данных под названием result, который выглядит так.
В принципе, я добавляю 4 столбца. Одна колонка для времени захода солнца, вторая для восхода солнца, третья для продолжительности ночи в часах и, наконец, четвертая для усилий по выборке (я просто добавляю временной бафф к продолжительности ночи). Мне удалось сделать это с помощью цикла в следующем коде (отключение пакета 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
Но бегать очень долго. Итак, я хотел бы знать, есть ли другой простой способ сделать это, используя, например, функцию mutate из пакета dplyr вместо использования цикла?
как предоставить образец моих реальных данных?
да, двух рядов будет достаточно. А из какой посылки getSunlightTimes?
пакет suncalc и хорошо, спасибо, я закончу фрейм данных
готово. Это нормально ? или чего-то не хватает?
@barthdufau, если ваша дата в 22-06-2000, то as.Date нужен аргумент format
извините, я заменяю данные правильным форматом @akrum
@barthdufau с dplyr, вы можете использовать rowwise, т.е. data %>% mutate(sset = as.Date(Night), sris = sset + 1) %>% rowwise %>% mutate(Tsset = getSunlightTimes(sset, lat, lng, keep = "sunset", tz = "UTC")$sunset, Tsris = getSunlightTimes(sris, lat, lng, keep = "sunrise", tz = "UTC")$sunrise) %>% ungroup (хотя это может быть не так быстро)
Ответы 2
Обновлять:
Нам не нужно использовать group_by или rowwise. Чтение ?getSunlightTimes говорит нам использовать data в качестве альтернативы, если у нас есть несколько координат:
Дата: Дата. Одна или несколько Дата. ГГГГ-ММ-ДД
лат.: числовой. Единая широта
лон : числовой. Единая долгота
данные: data.frame. Альтернатива использованию даты, широты, долготы для передачи нескольких координат
держать : характер. Вектор сохраняемых переменных. Смотрите подробности
tz :> символ. Часовой пояс результатов
Таким образом, мы можем передать фрейм данных в функцию целиком, но должны иметь правильные имена для столбцов. См. ниже;
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) и пройти только первую лат и долготу для каждой группы.
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
Когда я выполняю этот код, консоль сообщает: Ошибка в .buildData(date = date, lat = lat, lon = lon, data = data): 'lat' должен быть уникальным элементом. Используйте «данные» для нескольких «латов»
@barthdufau, ты видишь, что у меня есть rowwise, верно? Это действительно важно, чтобы это работало.
@barthdufau Я добавил альтернативу, которая не требует зацикливания и работает значительно быстрее.
Базовый расчет можно выполнить в tidyverse с помощью rowwise, т. е. getSunlightTimes не векторизован для lat, long, поэтому мы должны предоставлять только одно значение за раз. Если есть дубликаты для «lat», «long» вместо rowwise, может быть лучше сделать group_by(lat, lng), а затем использовать first(lat), first(lng) в вызове getSunlightTimes
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))
когда я запускаю этот код, cosonle сказал: Ошибка в .buildData(date = date, lat = lat, lon = lon, data = data): 'lat' должен быть уникальным элементом. Используйте «данные» для нескольких «латов»
@barthdufau была опечатка. если добавить rowwise как в обновлении, должно работать
Вам необходимо предоставить минимальный воспроизводимый пример ваших данных.