I'd like to fit models to a grouped data frame and then predict one new value per model (i.e. group).
library(dplyr)
library(broom)
data(iris)
dat <- rbind(iris, iris)
dat$Group <- rep(c("A", "B"), each = 150)
new.dat <- data.frame(Group = rep(c("A", "B"), each = 3),
Species = rep(c("setosa", "versicolor", "virginica"), times = 2),
Sepal.Width = 1:6)
> new.dat
Group Species val
1 A setosa 1
2 A versicolor 2
3 A virginica 3
4 B setosa 4
5 B versicolor 5
6 B virginica 6
However, augment returns 36 rows, as if each new value is fit with each model. How can I preserve the grouping here and get one fitted value per group?
dat %>%
group_by(Species, Group) %>%
do(augment(lm(Sepal.Length ~ Sepal.Width, data = .), newdata = new.dat))
# A tibble: 36 x 5
# Groups: Species, Group [6]
Group Species Sepal.Width .fitted .se.fit
<fct> <fct> <int> <dbl> <dbl>
1 A setosa 1 3.33 0.221
2 A versicolor 2 4.02 0.133
3 A virginica 3 4.71 0.0512
4 B setosa 4 5.40 0.0615
5 B versicolor 5 6.09 0.145
6 B virginica 6 6.78 0.234
7 A setosa 1 3.33 0.221
8 A versicolor 2 4.02 0.133
9 A virginica 3 4.71 0.0512
10 B setosa 4 5.40 0.0615
# ... with 26 more rows
(Note that due to the example data the rows are actually duplicates, which is however not the case with my original data).
You need to make the Species and Group of new.dat match those of the group currently being processed in do. You can do this like so:
group.cols <- c("Species", "Group")
dat %>%
group_by(!!! group.cols) %>%
do(augment(lm(Sepal.Length ~ Sepal.Width, data = .),
newdata = semi_join(new.dat, ., by = group.cols)))
Related
I have the following data frame:
df<- splitstackshape::stratified(iris, group="Species", size=1)
I want to make a z-score for each species including all of the variables. I can do this manually by finding the SD and mean for each row and using the appropriate formula, but I need to do this several times over and would like to find a more efficient way.
I tried using scale(), but can't figure out how to get it to do the row-wise calculation that includes several variables and a grouping variable.
Using dplyr::group_by returns a "'x' must be numeric variable" error.
Are you sure the question is taking a z-score to each group? It should be for each value.
Lets say the functions to take z-score could be:
scale(x, center = TRUE, scale = TRUE)
Or
function_zscore = function(x){x <- x[na.rm = TRUE]; return(((x) - mean(x)) / sd(x))}
Both functions suggest that if the argument x is a vector, the results will return to a vector too.
df<- splitstackshape::stratified(iris, group="Species", size=1)
df <- tidyr::pivot_longer(df, cols = c(1:4), names_to = "var.name", values_to = "value")
df %>%
group_by(Species) %>%
mutate(zscore = scale(value, center = TRUE, scale = TRUE)[,1])
## A tibble: 12 x 4
## Groups: Species [3]
# Species var.name value zscore
# <fct> <chr> <dbl> <dbl>
# 1 setosa Sepal.Length 4.9 1.22
# 2 setosa Sepal.Width 3.1 0.332
# 3 setosa Petal.Length 1.5 -0.455
# 4 setosa Petal.Width 0.2 -1.09
# 5 versicolor Sepal.Length 5.9 1.10
# 6 versicolor Sepal.Width 3.2 -0.403
# 7 versicolor Petal.Length 4.8 0.486
# 8 versicolor Petal.Width 1.8 -1.18
# 9 virginica Sepal.Length 6.5 1.14
#10 virginica Sepal.Width 3 -0.574
#11 virginica Petal.Length 5.2 0.501
#12 virginica Petal.Width 2 -1.06
If we still hope to get a score for each group to describe how a sample deviates around the mean, a possible solution could be getting the coefficient of variation?
df %>%
group_by(Species) %>%
summarise(coef.var = 100*sd(value)/mean(value))
## A tibble: 3 x 2
# Species coef.var
# <fct> <dbl>
#1 setosa 83.8
#2 versicolor 45.8
#3 virginica 49.0
I need to mutate a column in a dataframe, with the seq of another column.
For example with iris, I would like to add a new column for each Species, with
seq(min(Sepal.Length),max(Sepal.Length),length=100)
I tried (with no success):
iris %>%
group_by(Species) %>%
mutate(seqq = seq(min(Sepal.Length),max(Sepal.Length), 100))
Any ideas?
thank you!
mutate needs to return the same number of rows as the original data or the ones in the group_by. We may use summarise
library(dplyr)
iris %>%
group_by(Species) %>%
summarise(seq = seq(min(Sepal.Length),max(Sepal.Length),
length = 100), .groups = 'drop')
-output
# A tibble: 300 x 2
# Groups: Species [3]
Species seq
<fct> <dbl>
1 setosa 4.3
2 setosa 4.32
3 setosa 4.33
4 setosa 4.35
5 setosa 4.36
6 setosa 4.38
7 setosa 4.39
8 setosa 4.41
9 setosa 4.42
10 setosa 4.44
# … with 290 more rows
I want to group my dataframe by year and standardize certain columns (In this case BioTest, MathExam, and WritingScore) and replace the old data with the new data.Below is an example of my dataframe:
DF:
Var1 Var2 Year BioTest MathExam WritingScore Var3 Var 4
X X 2016 165 140 10 X X
X X 2017 172 128 11 X X
X X 2018 169 115 8 X X
X X 2016 166 139 10 X X
X X 2017 165 140 12 X X
I have tried variations of the following code:
DF<- DF %>% group_by(Year)%>% mutate(across(BioTest:WritingScore),scale)
DF<- DF %>% group_by(Year)%>% mutate(across(select(BioTest:WritingScore)),scale)
What I get in return is the same DF without any changes. What I want is:
DF:
Var1 Var2 Year BioTest MathExam WritingScore Var3 Var 4
X X 2016 NewData NewData NewData X X
X X 2017 NewData NewData NewData X X
X X 2018 NewData NewData NewData X X
X X 2016 NewData NewData NewData X X
X X 2017 NewData NewData NewData X X
Any help is much appreciated.
The issue could be that dplyr::mutate was masked by the plyr::mutate. It can be reproduced with (along with the fact that across is closed without a function)
iris %>%
group_by(Species) %>%
plyr::mutate(across(where(is.numeric), scale))
# A tibble: 150 x 5
# Groups: Species [3]
# Sepal.Length Sepal.Width Petal.Length Petal.Width Species
# <dbl> <dbl> <dbl> <dbl> <fct>
# 1 5.1 3.5 1.4 0.2 setosa
# 2 4.9 3 1.4 0.2 setosa
# 3 4.7 3.2 1.3 0.2 setosa
# 4 4.6 3.1 1.5 0.2 setosa
# 5 5 3.6 1.4 0.2 setosa
# 6 5.4 3.9 1.7 0.4 setosa
# 7 4.6 3.4 1.4 0.3 setosa
# 8 5 3.4 1.5 0.2 setosa
# 9 4.4 2.9 1.4 0.2 setosa
#10 4.9 3.1 1.5 0.1 setosa
# … with 140 more rows
which is the same as the initial 'iris' dataset
Now, check with the correct dplyr::mutate
iris %>%
group_by(Species) %>%
dplyr::mutate(across(where(is.numeric), scale))
# A tibble: 150 x 5
# Groups: Species [3]
# Sepal.Length[,1] Sepal.Width[,1] Petal.Length[,1] Petal.Width[,1] Species
# <dbl> <dbl> <dbl> <dbl> <fct>
# 1 0.267 0.190 -0.357 -0.436 setosa
# 2 -0.301 -1.13 -0.357 -0.436 setosa
# 3 -0.868 -0.601 -0.933 -0.436 setosa
# 4 -1.15 -0.865 0.219 -0.436 setosa
# 5 -0.0170 0.454 -0.357 -0.436 setosa
# 6 1.12 1.25 1.37 1.46 setosa
# 7 -1.15 -0.0739 -0.357 0.512 setosa
# 8 -0.0170 -0.0739 0.219 -0.436 setosa
# 9 -1.72 -1.39 -0.357 -0.436 setosa
#10 -0.301 -0.865 0.219 -1.39 setosa
# … with 140 more rows
So, in the OP's code, we just need to use dplyr::mutate or restart a fresh R session with only dplyr loaded
DF %>%
group_by(Year)%>%
dplyr::mutate(across(BioTest:WritingScore, scale))
scale returns a matrix with some attributes. If we only need the numeric vector part, we can either use as.vector or as.numeric
DF %>%
group_by(Year)%>%
dplyr::mutate(across(BioTest:WritingScore, ~ as.numeric(scale(.)))
NOTE: The select is not needed within across
Maybe try this. THe issue is on your across() statement. The function must be inside on it:
library(dplyr)
#Code
DF %>%
group_by(Year) %>%
mutate(across(BioTest:WritingScore,~scale(.)[,1]))
Output:
# A tibble: 5 x 9
# Groups: Year [3]
Var1 Var2 Year BioTest[,1] MathExam[,1] WritingScore[,1] Var3 Var X4
<chr> <chr> <int> <dbl> <dbl> <dbl> <chr> <chr> <lgl>
1 X X 2016 -0.707 0.707 NaN X X NA
2 X X 2017 0.707 -0.707 -0.707 X X NA
3 X X 2018 NaN NaN NaN X X NA
4 X X 2016 0.707 -0.707 NaN X X NA
5 X X 2017 -0.707 0.707 0.707 X X NA
Some data used:
#Data
DF <- structure(list(Var1 = c("X", "X", "X", "X", "X"), Var2 = c("X",
"X", "X", "X", "X"), Year = c(2016L, 2017L, 2018L, 2016L, 2017L
), BioTest = c(165L, 172L, 169L, 166L, 165L), MathExam = c(140L,
128L, 115L, 139L, 140L), WritingScore = c(10L, 11L, 8L, 10L,
12L), Var3 = c("X", "X", "X", "X", "X"), Var = c("X", "X", "X",
"X", "X"), X4 = c(NA, NA, NA, NA, NA)), class = "data.frame", row.names = c(NA,
-5L))
Let's say we want to calculate the means of sepal length based on tercile groups of sepal width.
We can use the split_quantile function from the fabricatr package and do the following:
iris %>%
group_by(split_quantile(Sepal.Width, 3)) %>%
summarise(Sepal.Length = mean(Sepal.Length))
So far so good. Now, let's say we want to group_by(Species, split_quantile(Sepal.Width, 3)) instead of just group_by(split_quantile(Sepal.Width, 3)).
However, what if we want the terciles to be calculated inside of the each species type and not generally?
Basically, what I'm looking for could be achieved by splitting iris into several dataframes based on Species, using split_quantile on those dataframes to calculate terciles and then joining the dataframes back together. However, I'm looking for a way to do this without splitting the dataframe.
You kinda have written the answer in your text, but you can create a new variable for tercile after grouping by species, then regroup with both Species and Tercile.
library(tidyverse)
library(fabricatr)
iris %>%
group_by(Species) %>%
mutate(Tercile = split_quantile(Sepal.Width, 3)) %>%
group_by(Species, Tercile) %>%
summarise(Sepal.Length = mean(Sepal.Length))
#> # A tibble: 9 x 3
#> # Groups: Species [3]
#> Species Tercile Sepal.Length
#> <fct> <fct> <dbl>
#> 1 setosa 1 4.69
#> 2 setosa 2 5.08
#> 3 setosa 3 5.27
#> 4 versicolor 1 5.61
#> 5 versicolor 2 6.12
#> 6 versicolor 3 6.22
#> 7 virginica 1 6.29
#> 8 virginica 2 6.73
#> 9 virginica 3 6.81
Created on 2020-05-27 by the reprex package (v0.3.0)
I've calculated a different regression for each group in a data frame:
DF.L <- DF %>%
group_by(Channel) %>%
do(Fit = rlm(L ~ -1 + Y + I(Y^2), data = .))
I want to apply this set of regressions to another data frame. To do so, I'm testing how to apply it to the same data frame:
DF %>%
group_by(Channel) %>%
do({
Lfit <- predict(subset(DF.L, Channel == unique(.$Channel))$Fit, .)
data.frame(., Lfit)
})
glimpse(DF)
But I keep getting this error:
Error in UseMethod("predict") :
no applicable method for 'predict' applied to an object of class "list"
Calls: %>% ... do_.grouped_df -> eval -> eval -> predict -> predict
What I am doing wrong?
Using the built-in ChickWeight data:
library(dplyr)
library(MASS)
library(broom)
library(tidyr)
library(ggplot2)
head(ChickWeight)
weight Time Chick Diet
1 42 0 1 1
2 51 2 1 1
3 59 4 1 1
4 64 6 1 1
5 76 8 1 1
6 93 10 1 1
Fit some models
ChickWeight_models <- ChickWeight %>%
group_by(Diet) %>%
do(fit = MASS::rlm(weight ~ Time + I(Time^2), data = .))
ChickWeight_models
Source: local data frame [4 x 2]
Groups: <by row>
# A tibble: 4 x 2
Diet fit
* <fctr> <list>
1 1 <S3: rlm>
2 2 <S3: rlm>
3 3 <S3: rlm>
4 4 <S3: rlm>
So I've created a very similar object to your DF.L. It's a frame with the four groups, each with an rlm object in a list-column called fit.
Make up some test data
Now I'll make up some data to test this model on. In this case, I'll just take the original data and add some noise to each of the variables.
ChickWeight_simulated <- ChickWeight %>%
mutate(Time = Time + runif(length(Time)),
weight = weight + rnorm(length(weight)))
ChickWeight_simulated
weight Time Chick Diet
1 42.72075 0.9786272 1 1
2 51.12669 2.8399631 1 1
3 58.64632 4.4576380 1 1
4 63.77617 6.1083591 1 1
5 75.40434 8.1051792 1 1
6 91.75830 10.7899030 1 1
Now we want to combine the dataframe of the models with the new data to test on. First we group_by and tidyr::nest the simulated data. This creates an object that is a dataframe with the four groups and a list-column called data, each element of which contains a rolled-up dataframe.
ChickWeight_simulated %>% group_by(Diet) %>% nest()
# A tibble: 4 x 2
Diet data
<fctr> <list>
1 1 <tibble [220 x 3]>
2 2 <tibble [120 x 3]>
3 3 <tibble [120 x 3]>
4 4 <tibble [118 x 3]>
Add the original models to the new data
Then we can join it to the models dataframe:
ChickWeight_simulated %>% group_by(Diet) %>% nest() %>%
full_join(ChickWeight_models)
# A tibble: 4 x 3
Diet data fit
<fctr> <list> <list>
1 1 <tibble [220 x 3]> <S3: rlm>
2 2 <tibble [120 x 3]> <S3: rlm>
3 3 <tibble [120 x 3]> <S3: rlm>
4 4 <tibble [118 x 3]> <S3: rlm>
Now we group by Diet again, and use broom::augment to make a prediction of each model on the new simulated data. Since each group is one row, there is one element each of fit and data; we have to extract that single element out of each list-column into a usable form by using [[1]].
ChickWeight_simulated_predicted <-
ChickWeight_simulated %>% group_by(Diet) %>% nest() %>%
full_join(ChickWeight_models) %>%
group_by(Diet) %>%
do(augment(.$fit[[1]], newdata = .$data[[1]]))
head(ChickWeight_simulated_predicted)
# A tibble: 6 x 6
# Groups: Diet [1]
Diet weight Time Chick .fitted .se.fit
<fctr> <dbl> <dbl> <ord> <dbl> <dbl>
1 1 42.72075 0.9786272 1 43.62963 2.368838
2 1 51.12669 2.8399631 1 51.80855 1.758385
3 1 58.64632 4.4576380 1 59.67606 1.534051
4 1 63.77617 6.1083591 1 68.43218 1.534152
5 1 75.40434 8.1051792 1 80.00678 1.647612
6 1 91.75830 10.7899030 1 97.26450 1.726331
Sanity check
To prove that this really only used the model from a particular level of Diet on the simulated data from that level of Diet, we can visualize the model fit.
ChickWeight_simulated_predicted %>%
ggplot(aes(Time, weight)) +
geom_point(shape = 1) +
geom_ribbon(aes(Time,
ymin = .fitted-1.96*.se.fit,
ymax = .fitted+1.96*.se.fit),
alpha = 0.5, fill = "black") +
geom_line(aes(Time, .fitted), size = 1, color = "red") +
facet_wrap(~Diet)
I think your error comes from how you are calling predict. I can't fix your exact code, but here is a simple way you can get predictions from your model. A more sophisticated way using purrr and nest is outlined here: http://ijlyttle.github.io/isugg_purrr/presentation.html#(1)
UPDATE - the purrr and nest way
Just adding this to show that it can be done pretty easily within the tidyverse, using predict. See link above for more details.
library(tidyverse)
# shuffle the rows to mix up the species
set.seed(1234)
myiris <- iris[sample(nrow(iris), replace = F),]
# create first dataset - use the first 50 rows for running the model
iris_nested <-
myiris[1:50,] %>%
nest(-Species) %>%
rename(myorigdata = data)
# create second dataset - use the other 100 rows for making predictions
new_iris_nested <-
myiris[51:150,] %>%
nest(-Species) %>%
rename(mynewdata = data)
# make a model function
my_rlm <- function(df) {
MASS::rlm(Sepal.Length ~ Petal.Length + Petal.Width, data = df)
}
# get the predictions (see the GitHub link above which breaks this into steps)
predictions_tall <-
iris_nested %>%
mutate(my_model = map(myorigdata, my_rlm)) %>%
full_join(new_iris_nested, by = "Species") %>%
mutate(my_new_pred = map2(my_model, mynewdata, predict)) %>%
select(Species, mynewdata, my_new_pred) %>%
unnest(mynewdata, my_new_pred) %>%
rename(modeled = my_new_pred, measured = Sepal.Length) %>%
gather("Type", "Sepal.Length", modeled, measured)
The nested predictions_tall object looks like this:
predictions_tall %>% nest(-Species, -type) %>% as.tibble()
# A tibble: 6 x 3
Species type data
<fctr> <chr> <list>
1 setosa modeled <data.frame [32 x 4]>
2 versicolor modeled <data.frame [33 x 4]>
3 virginica modeled <data.frame [35 x 4]>
4 setosa measured <data.frame [32 x 4]>
5 versicolor measured <data.frame [33 x 4]>
6 virginica measured <data.frame [35 x 4]>
And finally, the plot to show the prediction results:
predictions_tall %>%
ggplot(aes(x = Petal.Length, y = Sepal.Length)) +
geom_line(aes(color = Species, linetype = Type))
ORIGINAL - the broom way
I've updated this now to only calculate predictions for each group using the model for that group.
This way uses the broom package - specifically the augment function - to add fitted values. See more here: https://cran.r-project.org/web/packages/broom/vignettes/broom.html
Since you don't supply data, I use iris here.
library(tidyverse)
library(broom)
# first shuffle around the rows of iris
set.seed(1234)
myiris <- iris[sample(nrow(iris), replace = F),]
# first data - first 25 rows for running the models on
origiris <-
myiris[1:25,] %>%
nest(-Species) %>%
rename(origdata = data)
# second data - last 50 rows for predicting on
prediris <-
myiris[101:150,] %>%
nest(-Species) %>%
rename(preddata = data)
# estimate models on the first 25 rows
# a separate model is estimated for each species
iris_mod <-
origiris %>%
mutate(mod = map(origdata, ~ MASS::rlm(Sepal.Length ~ Petal.Length + Petal.Width, data = .)))
First get fitted values for the original dataset (not essential, just for illustration):
# get fitted values for the first dataset (origdata)
origiris_aug <-
iris_mod %>%
mutate(origpred = map(mod, augment)) %>%
unnest(origpred) %>%
as.tibble()
The origiris_aug predictions dataframe looks like this:
origiris_aug
# A tibble: 25 x 10
Species .rownames Sepal.Length Petal.Length Petal.Width .fitted .se.fit .resid
<fctr> <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
1 setosa 18 5.1 1.4 0.3 5.002797 0.1514850 0.09720290
2 setosa 2 4.9 1.4 0.2 4.931824 0.1166911 -0.03182417
3 setosa 34 5.5 1.4 0.2 4.931824 0.1166911 0.56817583
4 setosa 40 5.1 1.5 0.2 4.981975 0.1095883 0.11802526
5 setosa 39 4.4 1.3 0.2 4.881674 0.1422123 -0.48167359
6 setosa 36 5.0 1.2 0.2 4.831523 0.1784156 0.16847698
7 setosa 25 4.8 1.9 0.2 5.182577 0.2357614 -0.38257703
8 setosa 31 4.8 1.6 0.2 5.032125 0.1241074 -0.23212531
9 setosa 42 4.5 1.3 0.3 4.952647 0.1760223 -0.45264653
10 setosa 21 5.4 1.7 0.2 5.082276 0.1542594 0.31772411
# ... with 15 more rows, and 2 more variables: .hat <dbl>, .sigma <dbl>
And now what you actually want - making predictions on the new dataset:
# get fitted values for the second dataset (preddata)
# each model is fitted to the appropriate species' nested dataframe
prediris_aug <-
iris_mod %>%
inner_join(prediris, by = "Species") %>%
map2_df(.x = iris_mod$mod, .y = prediris$preddata, .f = ~augment(.x, newdata = .y)) %>%
as.tibble()
The prediris_aug dataframe looks like this:
prediris_aug
# A tibble: 50 x 7
.rownames Sepal.Length Sepal.Width Petal.Length Petal.Width .fitted .se.fit
<chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
1 105 6.5 3.0 5.8 2.2 8.557908 3.570269
2 115 5.8 2.8 5.1 2.4 8.348800 3.666631
3 117 6.5 3.0 5.5 1.8 8.123565 3.005888
4 139 6.0 3.0 4.8 1.8 7.772511 2.812748
5 103 7.1 3.0 5.9 2.1 8.537086 3.475224
6 107 4.9 2.5 4.5 1.7 7.551086 2.611123
7 119 7.7 2.6 6.9 2.3 9.180537 4.000412
8 135 6.1 2.6 5.6 1.4 7.889823 2.611457
9 124 6.3 2.7 4.9 1.8 7.822661 2.838502
10 118 7.7 3.8 6.7 2.2 9.009263 3.825613
# ... with 40 more rows