Блог

У меня есть два фрейма данных и одна функция. Предполагается, что функция принимает переменные start_month amp; end_month , выбирает для каждой строки значения во втором фрейме данных в month -столбце, вычисляет rate_of_change между каждой start_month и end_month переменной за данный год.
Наконец, вычислите mean(rate_of_change) и поместите его в первый фрейм данных в качестве новой переменной в векторе average_ratio .

На данный момент я создал код, который вычисляет среднее соотношение, но мне не удается поместить его в цикл for или функцию apply, чтобы цикл проходил через весь первый фрейм данных. У меня есть две идеи, но пока они не работают.

   structure(Total) # Df containing total combinations of all existing month starting in September
  

.

 i  | start_month | end_month | average_ratio (expected output)
1  |  9          | 10        |   -23
2  |  9          | 11        |    13
3  |  9          | 12        |    -4     
4  |  9          | 1         |       
5  |  9          | 2         |       # ... with 61 more rows
  

 and 
  structure(Cologne)
# A tibble: 3,000 x 4
    year month price town    (rate of change)
   <dbl> <dbl> <dbl> <chr>  
 1  1531     7  7575 Cologne
 2  1531     8   588 Cologne
 3  1531     9   615 Cologne
 4  1531    10    69 Cologne -88%
 5  1531    11   712 Cologne
 6  1531    12   590 Cologne
 7  1532     1    72 Cologne
 8  1532     2   675 Cologne
 9  1532     3  6933 Cologne
10  1532     4    54 Cologne
11  1532     5   425 Cologne
12  1532     6    12 Cologne
13  1532     7   323 Cologne
14  1532     8    32 Cologne
15  1532     9    58 Cologne
16  1532     10   84 Cologne  42%
# ... with 2,990 more rows
  

 # rate of change function
rateofchange <- function(x,y) {
  ((x-y)/y)*100
}

# avg_ratio function
avg_ratio <- function(x,y,z) {
  dt.frame <- filter(x, month==y | month==z)
  pre_p <- lag(dt.frame$price, 1)
  dt.frame <- cbind(dt.frame, pre_p)
  
  for (i in 1:nrow(dt.frame)) {
    dt.frame$roc <- rateofchange(dt.frame$price,dt.frame$pre_p)
  }
  result <- mean(dt.frame$roc,na.rm=TRUE)
  return(result)
}

May_Aug <- avg_ratio(Cologne, 5,7)


################ works until here ################

# Now, Idea 1
Total <- Total %>%
  mutate(Total, ratio = avg_ratio(Cologne,Total$start_mth,Total$end_mth)
         )
Warning messages:
1: In month == y :
  longer object length is not a multiple of shorter object length
2: In month == z :
  longer object length is not a multiple of shorter object length


# and Idea 2
ratio <- c()
Total_new <- for(i in 1:nrow(Total)) {
  ratio [i] <- c(ratio, avg_ratio(Cologne,Total$start_mth[i],Total$end_mth[i]))
  return(cbind(Total,ratio))
}
  

 > dput(Cologne[1:20,])
structure(list(year = c(1531, 1531, 1531, 1531, 1531, 1531, 1532, 
1532, 1532, 1532, 1532, 1532, 1532, 1532, 1532, 1532, 1532, 1532, 
1533, 1533), month = c(7, 8, 9, 10, 11, 12, 1, 2, 3, 4, 5, 6, 
7, 8, 9, 10, 11, 12, 1, 2), price = c(7575, 588, 615, 69, 712, 
72, 72, 675, 6933, 70, 656, 66, 62, 48, 48, 462, 45, 45, 456, 
46), town = c("Cologne", "Cologne", "Cologne", "Cologne", "Cologne", 
"Cologne", "Cologne", "Cologne", "Cologne", "Cologne", "Cologne", 
"Cologne", "Cologne", "Cologne", "Cologne", "Cologne", "Cologne", 
"Cologne", "Cologne", "Cologne")), spec = structure(list(cols = list(
    Jahr = structure(list(), class = c("collector_double", "collector"
    )), Monat = structure(list(), class = c("collector_double", 
    "collector")), cologne_wheat_monthly = structure(list(), class = c("collector_number", 
    "collector"))), default = structure(list(), class = c("collector_guess", 
"collector")), skip = 1), class = "col_spec"), row.names = c(NA, 
20L), class = c("tbl_df", "tbl", "data.frame"))


> dput(Total) structure(list(start_mth = c(9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 11, 11, 11, 11, 11, 11, 11, 11, 11, 12, 12, 12, 12, 12, 12, 12, 12, 1, 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2, 3, 3, 3, 3, 3, 4, 4, 4, 4, 5, 5, 5, 6, 6, 7), end_mth = c(10, 11, 12, 1, 2, 3, 4, 5, 6, 7, 8, 11, 12, 1, 2, 3, 4, 5, 6, 7, 8, 12, 1, 2, 3, 4, 5, 6, 7, 8, 1, 2, 3, 4, 5, 6, 7, 8, 2, 3, 4, 5, 6, 7, 8, 3, 4, 5, 6, 7, 8, 4, 5, 6, 7, 8, 5, 6, 7, 8, 6, 7, 8, 7, 8, 8)), class = "data.frame", row.names = c(NA, -66L))
  

Вы можете сделать:

 Total$average_ratio <- mapply(avg_ratio, y = Total$start_mth, z = Total$end_mth, MoreArgs = list(x = cologne))
  

Ваша функция не векторизована, вот почему это не работает:

 Total <- Total %>%
  mutate(ratio = avg_ratio(cologne, start_mth, end_mth))
  

mapply() Функция выполняет итерацию (или векторизацию) по предоставленным аргументам, однако вы не хотите выполнять итерацию по cologne, поэтому вы передаете ее внутрь MoreArgs = , поэтому она принимается такой, какая она есть.