Augmenter la vitesse/l'efficacité du code en évitant la fonction apply()
J'ai le dataframe suivant:
Model <- c("HS5", "HS5", "HS5","HS4")
Length <- c(6, 6, 6, 6)
Code <- c("030299", "010121","030448","030324")
df <- data.frame(Model,Length,Code)
Model Length Code
HS5 6 030299
HS5 6 010121
HS5 6 030448
HS4 6 030324
Je souhaite appliquer le code suivant à chaque ligne et générer le résultat sous la forme d'une nouvelle colonne
library(concordance)
concord(sourcevar = (each row of 'Code' column), origin = as.character(character in 'Model' column), destination = "HS4", dest.digit = as.numeric(number in 'Length' column), all = F))
En utilisant le code ci-dessous, nous appliquons la fonction 'concordance' (Page 6) à chaque ligne et générons un résultat, cependant, apply(
) la fonction fonctionne trop lentement sur les données volumineuses, ma question est de savoir s'il est possible d'augmenter d'une manière ou d'une autre la vitesse de ce code, même en changeant de apply()
fonction
df$New <- df$Code
df[df$Model!= "HS4", ]$New <- apply(df[df$Model!= "HS4", ], 1, \(x) concord(sourcevar = x[colnames(df) == "Code"],
origin = x[colnames(df) == "Model"], destination = "HS4",
dest.digit = x[colnames(df) == "Length"], all = F))
La question précédente
Solution du problème
Vous pouvez probablement l'accélérer en tirant parti de la façon dont concord
accepte une entrée vectorielle de l' sourcevar
argument. Le défi est que les autres arguments n'acceptent pas les entrées vectorielles. Par conséquent, vous pouvez essayer une stratégie pour effectuer une opération vectorisée sur sourcevar
pour chaque combinaison unique des autres arguments (origine, dest.digit, destination).
library(tidyverse)
library(concordance)
# create data sample
Model <- c("HS5", "HS5", "HS5", "HS4")[1:3]
Length <- c(6)
Code <- c("030299", "010121","030448","030324")
df <- expand_grid(Model, Length, Code) %>%
expand_grid(id = 1:5)
print(df)
#> # A tibble: 60 x 4
#> Model Length Code id
#> <chr> <dbl> <chr> <int>
#> 1 HS5 6 030299 1
#> 2 HS5 6 030299 2
#> 3 HS5 6 030299 3
#> 4 HS5 6 030299 4
#> 5 HS5 6 030299 5
#> 6 HS5 6 010121 1
#> 7 HS5 6 010121 2
#> 8 HS5 6 010121 3
#> 9 HS5 6 010121 4
#> 10 HS5 6 010121 5
#> #... with 50 more rows
# call concord vectorized over sourevar
tic <- Sys.time()
df %>%
group_by(Model, Length) %>%
mutate(
value = concord(Code, origin = unique(Model), dest.digit = unique(Length), destination = "HS4", all = FALSE)
) %>%
ungroup()
#> # A tibble: 60 x 5
#> Model Length Code id value
#> <chr> <dbl> <chr> <int> <chr>
#> 1 HS5 6 030299 1 030289
#> 2 HS5 6 030299 2 030289
#> 3 HS5 6 030299 3 030289
#> 4 HS5 6 030299 4 030289
#> 5 HS5 6 030299 5 030289
#> 6 HS5 6 010121 1 010121
#> 7 HS5 6 010121 2 010121
#> 8 HS5 6 010121 3 010121
#> 9 HS5 6 010121 4 010121
#> 10 HS5 6 010121 5 010121
#> #... with 50 more rows
print(Sys.time() - tic)
#> Time difference of 0.1580009 secs
# not vectorized
tic <- Sys.time()
df %>%
mutate(
value = lst(sourcevar = Code, origin = Model, dest.digit = Length) %>%
pmap_chr(concord, destination = "HS4", all = FALSE)
)
#> # A tibble: 60 x 5
#> Model Length Code id value
#> <chr> <dbl> <chr> <int> <chr>
#> 1 HS5 6 030299 1 030289
#> 2 HS5 6 030299 2 030289
#> 3 HS5 6 030299 3 030289
#> 4 HS5 6 030299 4 030289
#> 5 HS5 6 030299 5 030289
#> 6 HS5 6 010121 1 010121
#> 7 HS5 6 010121 2 010121
#> 8 HS5 6 010121 3 010121
#> 9 HS5 6 010121 4 010121
#> 10 HS5 6 010121 5 010121
#> #... with 50 more rows
print(Sys.time() - tic)
#> Time difference of 4.267002 secs
Créé le 2022-04-14 par le paquet reprex (v2.0.1)
Commentaires
Enregistrer un commentaire