R: пользовательская функция не возвращает новый столбец (+ пример данных) - PullRequest
0 голосов
/ 15 октября 2019

Я пишу функцию для установки различных параметров в зависимости от того, какие породы деревьев выбраны, и для вывода кадра данных с дополнительным вычисляемым столбцом: top_height.

Мне бы хотелось, чтобы функция была удобной для Magrittr pipe%>%, поэтому я пытаюсь включить вызов .data (?). Я включил предложение для обработки NA (установите в 999, чтобы избежать нецифрового в двоичный оператор в общей функции после определения параметров - добавление na.rm = T к вызову функции, похоже, не работает). Я также включил предложение для обработки grouped_df, если это проанализировано. Я не уверен, что эта часть работает - мне не удалось протестировать ее.

Проблема, которую я получаю, заключается в том, что функция, похоже, не управляет вызовом .data [top_height].

Error in `[[<-.data.frame`(`*tmp*`, top_height, value = c(NA, NA, NA, : object 'top_height' not found

Включение возраста, роста и вида вручную не решает проблему, но вызывает проблемы с нижним индексом:

hojdbonitering("ScotsPine",age=24,height=5.2)
Error in .data[[age]] : subscript out of bounds

Вот что у меня есть. Пример данных ниже.

#Create function for hojdbonitering.

hojdbonitering <- function(.data,species=c("NorwaySpruce","ScotsPine","Larch","Beech","Oak","Birch","AlnusIncana","AlnusGlutinosa","Aspen"),
                           age, height,...){
  #Control if data is a grouped _df.. Call iteratively if so.
  if (dplyr::is_grouped_df(.data)) {
    return(dplyr::do(.data, hojdbonitering(.,...))) 
  } 

   #Prevent incorrect inputs.
  stopifnot(species %in% c("NorwaySpruce","ScotsPine","Larch","Beech","Oak","Birch","AlnusIncana","AlnusGlutinosa","Aspen"))

  #Set top_height to NA if input not numeric.
  if(!is.numeric(.data[[age]]) | !is.numeric(.data[[height]])){
   .data[[top_height]] <- 999
    return(.)
  }

  #Set params.
  if(species=="NorwaySpruce"){
    age <- age-3
    paramasi <- 10
    parambeta <- 1495.3 
    paramb2 <- -1.5978
    refAge <- 100-3
  } else if(species=="ScotsPine"){
      paramasi <- 25
      parambeta <- 7395.6
      paramb2 <- -1.7829
      refAge <- 100
    } else if(species=="Larch"){
      paramasi <- 17.97
        parambeta <- 1529
        paramb2 <- -1.3451
        refAge <- 100
    } else if(species=="Beech"){
        paramasi <- 15
          parambeta <- 4239.3 
          paramb2 <- -1.7753
          refAge <- 100
    } else if(species=="Oak"){
        paramasi <- 1000
          parambeta <- 8841.4 
          paramb2 <- -1.4317
          refAge <- 100
    } else if(species=="Birch"){
        paramasi <- 7
          parambeta <- 394 
          paramb2 <- -1.387
          refAge <- 50
    } else if(species=="AlnusIncana"){
        paramasi <- 7
          parambeta <- 278.9 
          paramb2 <- -1.3152
          refAge <- 50
    } else if(species=="AlnusGlutinosa"){
        paramasi <- 7
          parambeta <- 381.5 
          paramb2 <- -1.3823
          refAge <- 50
    } else if(species=="Aspen"){
        paramasi <- 7
          parambeta <- 693.2 
          paramb2 <- -0.9771
          refAge <- 50
    }

  #Define general function
  d <- parambeta*(paramasi^paramb2)
  r <- (((.data[[height]]-d)^2)+(4*parambeta*.data[[height]]*(.data[[age]]^paramb2)))^0.5
  .data[[top_height]] <- (.data[[height]]+d+r)/ (2+(4*parambeta*(refAge^paramb2)) / (.data[[height]]-d+r))

  return(.data)
  }

Пример данных

species <- c("ScotsPine", "NorwaySpruce", "ScotsPine", "Beech", "ScotsPine")
age <- c(15,23,26,14,20)
height <- c(6.3, 7.2, 9.7, 2.5, 7.1)
fake.frame <- data.frame(cbind(species, age, height))
...