Расчет с применением

Question

У меня есть одна таблица с пятью столбцами Год, Доход, Пенсии, Доход и Заработная плата. С этой таблицей я произвел расчет с кодом ниже:

library(dplyr)
#DATA
TEST<-data.frame(
  Year= c(2000,2001,2002,2003,2004,2005,2006,2007,2008,2009,2010,2011,2012,2013,2014,2015,2016,2017,2018,2019,2020,2021),
  Revenue =c(8634,5798,6022,6002,6266,6478,6732,7224,6956,6968,7098,7620,7642,8203,9856,20328,22364,22222,23250,25250,26250,27250),
  Pensions =c(8734,5798,7011,7002,7177,7478,7731,7114,7957,7978,7098,7710,7742,8203,9857,10328,11374,12211,13150,15150,17150,17150),
  Income =c(8834,5898,6033,6002,6366,6488,6833,8334,6956,6968,8098,8630,8642,8203,9856,30328,33364,32233,33350,35350,36350,38350),
  Wages =c(8834,5598,8044,8002,8488,8458,8534,5444,8958,8988,5098,5840,5842,8203,9858,40328,44384,42244,43450,45450,48450,45450)
    )

#FUNCTION
fun1 <- function(x){ ((x - lag(x))/lag(x))*100}

#CALCULATION
ESTIMATION_0<-mutate(TEST,
                     Nominal_growth_Revenue=fun1(Revenue),
                     Nominal_growth_Pensions=fun1(Pensions),
                     Nominal_growth_Income=fun1(Income),
                     Nominal_growth_Wages=fun1(Wages)
                      )

Но я намерен оптимизировать этот код и сделатьэтот расчет с применением функции (или что-то подобное).Именно для этого вычисления я написал 4 строки кода, но мне нравится делать это с одной строкой кода.Так кто-нибудь может мне помочь с этой проблемой?

Answer 1

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

vars_names <- paste0("Nominal_groth", names(select(TEST, -Year)))

TEST %>%
  bind_cols( (TEST %>% mutate_at(vars(-Year), ~fun1(.x))) %>% select(-Year) %>% set_names(vars_names) )
   Year Revenue Pensions Income Wages Nominal_grothRevenue Nominal_grothPensions Nominal_grothIncome Nominal_grothWages
1  2000    8634     8734   8834  8834                   NA                    NA                  NA                 NA
2  2001    5798     5798   5898  5598          -32.8468844           -33.6157545         -33.2352275       -36.63119765
3  2002    6022     7011   6033  8044            3.8634012            20.9210072           2.2889115        43.69417649
4  2003    6002     7002   6002  8002           -0.3321156            -0.1283697          -0.5138405        -0.52212829
5  2004    6266     7177   6366  8488            4.3985338             2.4992859           6.0646451         6.07348163
6  2005    6478     7478   6488  8458            3.3833387             4.1939529           1.9164310        -0.35344015
7  2006    6732     7731   6833  8534            3.9209633             3.3832576           5.3175092         0.89855758
8  2007    7224     7114   8334  5444            7.3083779            -7.9808563          21.9669252       -36.20810874
9  2008    6956     7957   6956  8958           -3.7098560            11.8498735         -16.5346772        64.54812638
10 2009    6968     7978   6968  8988            0.1725129             0.2639186           0.1725129         0.33489618
11 2010    7098     7098   8098  5098            1.8656716           -11.0303334          16.2169920       -43.27992879
12 2011    7620     7710   8630  5840            7.3541843             8.6221471           6.5695233        14.55472734
13 2012    7642     7742   8642  5842            0.2887139             0.4150454           0.1390498         0.03424658
14 2013    8203     8203   8203  8203            7.3410102             5.9545337          -5.0798426        40.41424170
15 2014    9856     9857   9856  9858           20.1511642            20.1633549          20.1511642        20.17554553
16 2015   20328    10328  30328 40328          106.2500000             4.7783301         207.7110390       309.08906472
17 2016   22364    11374  33364 44384           10.0157418            10.1278079          10.0105513        10.05752827
18 2017   22222    12211  32233 42244           -0.6349490             7.3588887          -3.3898813        -4.82155732
19 2018   23250    13150  33350 43450            4.6260463             7.6897879           3.4653926         2.85484329
20 2019   25250    15150  35350 45450            8.6021505            15.2091255           5.9970015         4.60299194
21 2020   26250    17150  36350 48450            3.9603960            13.2013201           2.8288543         6.60066007
22 2021   27250    17150  38350 45450            3.8095238             0.0000000           5.5020633        -6.19195046

Answer 2

Предполагая, что у вас есть вектор символов с соответствующими столбцами:

cols <- c("Revenue", "Pensions", "Income", "Wages")

Используйте apply():

TEST[paste0('nomial_growth', cols)] <- apply(TEST[cols], 2, fun1) 

или data.table:

library(data.table)
setDT(TEST)
TEST[, (paste0('nomial_growth', cols)) := lapply(.SD, fun1), .SDcols = cols]