# Calculate regression coefficients for individuals (low sample size regression)?

Is there a way to calculate the regression coefficients for individuals instead of just a group resp. calculating regression coefficients for a very small sample size?

Background

My goal is to test different ways to cluster/segment a group of people. In the domain in question the best variables to use for segmentation would be variables that best express the importance an individual places on certain attributes.

However I do not have direct measurement of that importance. What I do have is an indirect measurement for the whole sample based on a shapley value regression of attribute ratings and final respondent choice.

Clearly put, I asked a couple of people how they would rate the attributes of a given brand and which brand they would choose in the end.

Now I wonder whether it is possible to obtain this indirect importance measurement also on an individual level which would mean either:

• Extracting individual coefficient estimators from the overall regression model ( I don't believe that is possible)
• Calculating a regression for each individual (Don't know how to do that hence the question)

Problem and what I tried

I work in R and I do know how to fit a grouped linear model. As all my respondents rated two brands I do have n = 2 per group.

However fitting a normal grouped linear model results in unusable results where almost all coefficients are NA and one or two equal 1. Additionally I would prefer to fit a relative importance or shapley value regression but the relaimpo package throws an error complaining about too few observations.

What other avenues could I pursue?

Update:

I have been using this code so far:

df %>%
group_by(i_TAN) %>%
do(model = lm(formula = Consideration ~ ., data = .))


@Ben Norris found out that the relaimpo packages has a hard minimum number of observations, so if I wanted to pursue this path I have to up my sample size.

As I only have the data that I have, I pursued a "hacky" solution which I am going to describe for completionists sake. The steps were as follows:

1. Assign each individual to one of k groups randomly, so that n/k > 4 (with n being the total sample size)

2. Repeat this step i couple of times,so that each individual is assigned to igroups

3. Split the total data set into a list of k dfs along the groups

4. Train a regression model with relaimpo for each data set

5. Average the resulting coefficients over all groups an individual was a part of to get approximate "individual coefficients"

This is a rather unscientific process but seemed better to me than simply "duplicating" individuals answers until the minimum sample size was met.

Here is the code I used:

library(dplyr)
library(magrittr)
library(relaimpo)

#create groups
df %>%
group_by(i_TAN) %>%
mutate(
g1 = as.integer(runif(n, 1, 51)),
g2 = as.integer(runif(n, 1, 51)),
g3 = as.integer(runif(n, 1, 51)),
g4 = as.integer(runif(n, 1, 51))
) %>%
{.} -> df

# Create all dfs
df %>%
select(i_TAN,g1,g2,g3,g4) %>%
gather(nam,group,-i_TAN) %>%
distinct() %>%
select(-nam) %>%
left_join(df, by = "i_TAN") %>%
select(1:35) %\$%
split(.,group) %>%
{.} -> list_of_df

lapply(list_of_df, function(x) { x["group"] <- NULL; x }) %>%
lapply(function(x) { x["i_TAN"] <- NULL; x }) %>%
{.} -> list_of_modelDF

# Fit all models
lapply(list_of_modelDF,function(x){lm(Consideration~.,data = x)}) -> list_of_reg

lapply(list_of_reg,function(x){relaimpo::calc.relimp(object = x, type = c("lmg"), rela = TRUE)}) -> list_of_relaimpo
$$$$


You can do this thing you want with the tidyr, dplyr, purrr and broom packages. The key workflow sequence is to

1. group your data with dplyr::group_by
2. use tidyr::nest to generate a list column of data.frames
3. use dplyr::mutate and purrr::map to generate a list column containing the models
4. use broom::tidy to convert the model into a data.frame
5. use tidyr::unnest to convert the model parameters back into readable data.

library(dplyr)
library(tidyr)
library(purrr)
library(broom)
# Setting up a simple example data.frame
df <- data.frame(ID = c(1, 1, 1, 2, 2, 2),
X = runif(6),
Y = rnorm(6))
df %>%
group_by(ID) %>%
nest() %>%
mutate(model = map(data, function(df) lm(X ~ Y, data = df))) %>%
mutate(tidy = map(model, tidy)) %>%
unnest(cols = c(tidy))
# A tibble: 4 x 8
# Groups:   ID [2]
ID data             model  term        estimate std.error statistic p.value
<dbl> <list>           <list> <chr>          <dbl>     <dbl>     <dbl>   <dbl>
1     1 <tibble [3 x 2]> <lm>   (Intercept)    0.453    0.0153    29.5    0.0215
2     1 <tibble [3 x 2]> <lm>   Y             -0.227    0.0128   -17.7    0.0360
3     2 <tibble [3 x 2]> <lm>   (Intercept)   -0.221    0.281     -0.787  0.576
4     2 <tibble [3 x 2]> <lm>   Y              0.366    0.207      1.76   0.328

• I tried out your exact example with the provided sample data but I get the following error Error in numeric(nrowz) : invalid 'length' argument which happens at the 1st mutate where we map the linear model. – Fnguyen Jun 10 '20 at 12:35
• @Fnguyen Based on this post stackoverflow.com/questions/58523399/…, the map function is also defined in the maps package and produces that error with invalid data (for the maps package). I am running a clean session with just the four packages I mentioned loaded . Try using purrr::map everywhere I have map. – Ben Norris Jun 10 '20 at 12:48
• Thanks it was indeed the purr::map call. However sadly this does not solve my problem. Your solution is equivalent to the group_by and do(lm()) I already did. This gets me to unusable results and cannot be adapted to relaimpo::calc which needs more observations. – Fnguyen Jun 10 '20 at 12:58
• I have played around with relaimpo` and it seems the problem is inherent to its need for a minimum of four observations, which your data does not have. If you don't have My method at least extracts the coefficient estimators from the model. – Ben Norris Jun 10 '20 at 18:35
• thank you for your input. Finding out the minimum observations for relaimpo has guided me towards a possible solution path. – Fnguyen Jun 12 '20 at 9:33