Вектор умножения на год с матрицей на год и месяц в R - PullRequest
0 голосов
/ 14 октября 2018

У меня есть два фрейма данных

df1 

Year  Farm 1  Farm 2  Farm 3
2015    1000    2000    1500
2016    500     2000    1000

df 2

Year Month  Farm 1 Farm 2 Farm 3
2015  Jan    1        1      3
2015  Feb    1        2      1
2016  Jan    2        2      2
2016  Feb    2        1      2

Я хочу умножить годовые значения в df1 для соответствующих ферм в df2 на основе года, чтобы получить результат ...

df 3 

Year    Month   Farm 1      Farm 2      Farm 3
2015    Jan     1000        2000        4500
2015    Feb     1000        4000        1500
2016    Jan     1000        4000        2000
2016    Feb     1000        2000        2000

Я правильно отформатировал годы, но изо всех сил пытался найти решение с помощью group_by в dplyr.Должен ли я попробовать другой путь?

Ответы [ 3 ]

0 голосов
/ 14 октября 2018

1) База R Предполагая, что df1 и df2, воспроизводимые в примечании в конце, объединяют кадры данных, давая кадр данных m.Затем создайте новый фрейм данных df3, заменив все, кроме первых двух coiumns d2, на произведение тех же столбцов df2 и соответствующих столбцов m.Пакеты не используются.

m <- merge(df2, df1, by = 1)
df3 <- replace(df2, -(1:2), df2[-(1:2)] * m[-(1:ncol(df2))] )

, что дает:

> df3
  Year Month Farm1 Farm2 Farm3
1 2015   Jan  1000  2000  4500
2 2015   Feb  1000  4000  1500
3 2016   Jan  1000  4000  2000
4 2016   Feb  1000  2000  2000

2) sqldf Если у вас есть только несколько ферм, так что можно написать их каждыйзатем:

library(sqldf)

sqldf("select 
         Year, 
         b.Month, 
         a.Farm1 * b.Farm1 Farm1,
         a.Farm2 * b.Farm2 Farm2,
         a.Farm3 * b.Farm3 Farm3
       from df2 b left join df1 a using (Year)")

давая:

  Year Month Farm1 Farm2 Farm3
1 2015   Jan  1000  2000  4500
2 2015   Feb  1000  4000  1500
3 2016   Jan  1000  4000  2000
4 2016   Feb  1000  2000  2000

Примечание

Lines1 <- "
Year  Farm1  Farm2  Farm3
2015    1000    2000    1500
2016    500     2000    1000"

Lines2 <- "
Year Month  Farm1 Farm2 Farm3
2015  Jan    1        1      3
2015  Feb    1        2      1
2016  Jan    2        2      2
2016  Feb    2        1      2"

df1 <- read.table(text = Lines1, header = TRUE)
df2 <- read.table(text = Lines2, header = TRUE)
0 голосов
/ 14 октября 2018

Вот вариант с соединением от data.table.Соедините второй набор данных ('df2') с первым ('df1') on столбцом 'Year' и умножьте .SD (Подмножество data.table на основе столбцов, указанных в .SDcols), насоответствующим столбцам в первых данных назначьте (:=) выходные данные для обновления столбцов «Ферма» во втором наборе данных

library(data.table)
nm1 <- grep("Farm", names(df1), value = TRUE)
setDT(df2)[df1, (nm1) := .SD * mget(paste0("i.", names(.SD))), 
           on = .(Year), .SDcols = nm1]
df2
#   Year Month Farm1 Farm2 Farm3
#1: 2015   Jan  1000  2000  4500
#2: 2015   Feb  1000  4000  1500
#3: 2016   Jan  1000  4000  2000
#4: 2016   Feb  1000  2000  2000
0 голосов
/ 14 октября 2018

Я бы подошел к этой проблеме, преобразовав фреймы данных в длинный формат, присоединившись к ним, а затем выполнив расчет.Вот пример:

# Load packages
library(dplyr)
library(tidyr)

# Make-up data
df1 = data.frame(Year = 2008:2018,
                 Farm1 = runif(n = 11, min = 0, max = 2000),
                 Farm2 = runif(n = 11, min = 0, max = 2000),
                 Farm3 = runif(n = 11, min = 0, max = 2000))

df2 = expand.grid(Year = 2008:2018,
                  Month = month.abb[1:12]) %>% 
  mutate(Farm1 = runif(n = 132, min = 0, max = 10),
         Farm2 = runif(n = 132, min = 0, max = 10),
         Farm3 = runif(n = 132, min = 0, max = 10))

# Transform data into long format
df1.long = df1 %>%
  gather(key = Farm, value = AnnualValue, Farm1:Farm3)

df2.long = df2 %>%
  gather(key = Farm, value = Value, Farm1:Farm3)

# Now left_join on Year and multiply columns
df.comb = left_join(df1.long, df2.long) %>% 
  mutate(NewValue = Value * AnnualValue)

# Transform back to wide format (if necessary)
df.comb.wide = df.comb %>% 
  select(-AnnualValue, -Value) %>% # drop values not included in wide format
  spread(key = Farm, value = NewValue)
...