Использование цикла for для итерации входных данных функции в R - PullRequest
Новая
       5

Использование цикла for для итерации входных данных функции в R

0 голосов
/ 26 сентября 2019

Я использую функцию, которая использует API для сбора данных.Я хотел бы динамически переключаться между различными входами, назначенными в «Годах» функции.В частности, я пытаюсь написать цикл for, чтобы циклически проходить каждый год и вводить его в функцию.

    Years = c("2019", "2018", "2017", "2016", "2015", "2014", "2013", "2012", "2011", "2010")  

    for (Year in names(Years)){


 YearVar <- Year
 Month <- "08"
 Day <- "01"

 Date <- paste(YearVar, Month, Day, sep = "/")

getHourlyLMP <- function(day = Date, locID = 4004, user = getOption(x       = "ISO_NE_USER"), password = getOption(x = "PASSWORD"), 
                                 out.tz = "America/New_York", ...){



 dd_Year <- format(as.Date(day), "%Y%m%d")
 json_Year <- get_path(path = paste0("/hourlylmp/da/final/day/",    dd_Year, "/location/", locID), user = user, password = password, ...)

 dat_Year <- do.call(what = "rbind", 
             lapply(json_Year$HourlyLmps$HourlyLmp, 
                    FUN = function(x){
                      dd_Year <- as.data.frame(x = x, stringsAsFactors = FALSE)
                      locId <- dd_Year[1,"Location"]
                      dd_Year <- dd_Year[2,]
                      dd_Year$locId <- locId
                      dd_Year
                    } ))

 dat_Year$BeginDate <- lubridate::ymd_hms(dat_Year$BeginDate, tz = out.tz)

 rownames(dat_Year) <- 1:nrow(dat_Year)

 return(dat_Year)
 }
  }

Когда я запускаю это, я получаю следующую ошибку: «Ошибка: $ operator недопустим для атомарных векторов»

Есть идеи, что является причиной ошибки?Спасибо!

1 Ответ

0 голосов
/ 26 сентября 2019

Не имея слишком много информации, я бы выбрал такой подход:

Во-первых, поместите функцию getHourlyLMP вне цикла ... Вы можете вызвать ее изнутри итераций и передатьпеременная в качестве параметра.

# The function we want to run for each year.

getHourlyLMP <- function(day = Date, locID = 4004, user = getOption(x = "ISO_NE_USER"), password = getOption(x = "PASSWORD"), out.tz = "America/New_York", ...){

  dd_Year <- format(as.Date(day), "%Y%m%d")
  json_Year <- get_path(path = paste0("/hourlylmp/da/final/day/", dd_Year, "/location/", locID), user = user, password = password, ...)

  dat_Year <- do.call(what = "rbind", 
                      lapply(json_Year$HourlyLmps$HourlyLmp, 
                             FUN = function(x){
                               dd_Year <- as.data.frame(x = x, stringsAsFactors = FALSE)
                               locId <- dd_Year[1,"Location"]
                               dd_Year <- dd_Year[2,]
                               dd_Year$locId <- locId
                               dd_Year
                             } ))

  dat_Year$BeginDate <- lubridate::ymd_hms(dat_Year$BeginDate, tz = out.tz)

  rownames(dat_Year) <- 1:nrow(dat_Year)

  return(dat_Year)
}

# Build the Date object in an easier way using ?sprintf
Years = c("2019", "2018", "2017", "2016", "2015", "2014", "2013", "2012", "2011", "2010")  

Date <- sprintf("%s/08/01", Years)

# Date
# [1] "2019/08/01" "2018/08/01" "2017/08/01" "2016/08/01" "2015/08/01" "2014/08/01" "2013/08/01" "2012/08/01" "2011/08/01" "2010/08/01"

# Now just loop through the Date objects
lapply(Date, function(i){
  getHourlyLMP(day = i)
})

После некоторых исследований и регистрации для API ....

Получите текущие LMP Final Da Hourly для данного местоположения. 

#Parameters
#name   description type    default
#day    The day to retrieve data for (YYYYMMDD) path    FORMAT IS VITAL
#locationId The location id path    

get_paths2 <- function(year = NULL, user = getOption("ISO_NE_USER"), pass = getOption("ISO_NE_PASS"), loc_id = 4004, out.tz = "America/New_York"){
  library(jsonlite)
  # Pay attention to the path query, which needs to be YYYYMMDD or 20190927... since you gave static date, i hard coded
  # the 0801, but change that for your needs moving forward
  base <- 'https://webservices.iso-ne.com/api/v1.1/hourlylmp/da/final/day/%s0801/location/%s'

  # Build our call url
  api_url <- sprintf(base, year, loc_id)

  # Call the API
  req <- httr::GET(api_url, httr::authenticate(user = user, password = pass, type = "basic"))
  # confirm the request worked by returning a 200 status code
  if(status_code(req) == 200L){
    data <- content(req)

    # Your data manipulation functions here:
    # I tested on a just 2 items in the list, and it works fine...
    # > rbind_pages(lapply(a$HourlyLmps$HourlyLmp[1:2], function(x){
    #     as.data.frame(x)
    # }))
    # 
    # Building a ?tryCatch in here...
    tryCatch({
      lapply(data$HourlyLmps$HourlyLmp, function(i){
        dd_Year <- as.data.frame(i, stringsAsFactors = FALSE)
        dd_Year %>% mutate(
          BeginDate = lubridate::ymd_hms(BeginDate, tz = out.tz, quiet = TRUE)
        )
      }) %>% rbind_pages()
    }, error = function(e){
      NA
    })
  }
}

Примечание:Оказывается, 2010 год не возвращает данные .... 

out_test <- setNames(lapply(Years, function(i){
    get_paths2(i)
}), Years)




> which(is.na(out_test))
2010 
  10 

> Map(slice, out_test[which(!is.na(out_test))], 1)
$`2019`
   BeginDate Location..LocId Location..LocType     Location.. LmpTotal EnergyComponent CongestionComponent LossComponent
1 2019-08-01            4004         LOAD ZONE .Z.CONNECTICUT     23.8           24.46                   0         -0.66

$`2018`
   BeginDate Location..LocId Location..LocType     Location.. LmpTotal EnergyComponent CongestionComponent LossComponent
1 2018-08-01            4004         LOAD ZONE .Z.CONNECTICUT    24.54           24.59                   0         -0.05

$`2017`
   BeginDate Location..LocId Location..LocType     Location.. LmpTotal EnergyComponent CongestionComponent LossComponent
1 2017-08-01            4004         LOAD ZONE .Z.CONNECTICUT    19.63           19.38                   0          0.25

$`2016`
   BeginDate Location..LocId Location..LocType     Location.. LmpTotal EnergyComponent CongestionComponent LossComponent
1 2016-08-01            4004         LOAD ZONE .Z.CONNECTICUT    28.26           28.08                   0          0.18

$`2015`
   BeginDate Location..LocId Location..LocType     Location.. LmpTotal EnergyComponent CongestionComponent LossComponent
1 2015-08-01            4004         LOAD ZONE .Z.CONNECTICUT    19.42           19.21                   0          0.21

$`2014`
   BeginDate Location..LocId Location..LocType     Location.. LmpTotal EnergyComponent CongestionComponent LossComponent
1 2014-08-01            4004         LOAD ZONE .Z.CONNECTICUT    22.27           21.98                   0          0.29

$`2013`
   BeginDate Location..LocId Location..LocType     Location.. LmpTotal EnergyComponent CongestionComponent LossComponent
1 2013-08-01            4004         LOAD ZONE .Z.CONNECTICUT    27.11           26.73                   0          0.38

$`2012`
   BeginDate Location..LocId Location..LocType     Location.. LmpTotal EnergyComponent CongestionComponent LossComponent
1 2012-08-01            4004         LOAD ZONE .Z.CONNECTICUT    26.59           26.45                   0          0.14

$`2011`
   BeginDate Location..LocId Location..LocType     Location.. LmpTotal EnergyComponent CongestionComponent LossComponent
1 2011-08-01            4004         LOAD ZONE .Z.CONNECTICUT    40.49           39.93                   0          0.56

Тогда можно объединить все с rbind_pages(out_test[which(!is.na(out_test))])

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.

Нет похожих вопросов

...