knitr::opts_chunk$set(
    echo = TRUE,
    message = FALSE,
    warning = FALSE
)
knitr::opts_knit$set(root.dir = normalizePath(".."))

Introdução

Eu resolvi fazer a análise em Markdown e fazer um upload no RPubs para todos irmos acompanhando. Assim, eu posso descrever um pouco mais do que eu estou fazendo e vocês podem reproduzir as análises.

Importando os dados

library(readxl)
dd <- read_excel("~/Google Drive/GDrive/UFRGS/Pesquisa/SES Experiential Purchases/Survey_CloudResearch/Experience Inquiry_1 Fapergs_July 11, 2023_15.33.xlsx", 
    col_names = FALSE, skip = 2)

names_dd <- read_excel("~/Google Drive/GDrive/UFRGS/Pesquisa/SES Experiential Purchases/Survey_CloudResearch/Experience Inquiry_1 Fapergs_July 11, 2023_15.33.xlsx", 
    col_names = FALSE)[1,]

names(dd) <- names_dd

# Antes de ir adiante, eu preciso filtrar as pessoas que falharam a manipulação ao não escrever nada ou texto inapropriado
ds <- subset(dd, dd$Rejected==0)

Caracterização do Respondente

Embora esse não seja um estudo descritivo, não custa explorar um pouco os dados e fazer uma caracterização da amostra.

require(knitr)
require(questionr)
ds$Sex.f <- factor(ds$Sex, levels = c(1,2,3), labels = c("Male","Female","Other"))
t.genero <- freq(ds$Sex.f, digits = 2, exclude = NA, total = T)
kable(t.genero, caption = "Distribuição de Respondentes por Gênero")
Distribuição de Respondentes por Gênero
n %
Male 108 40.00
Female 158 58.52
Other 4 1.48
Total 270 100.00 
require(ggsci)
require(ggplot2)
ggplot(t.genero[-4,], aes(x="", y=`%`,fill=rownames(t.genero[-4,]), label = round(`%`,2)))+
  geom_bar(width = 1, stat = "identity")+
  geom_text(position = position_stack(vjust = 0.5),size = 5)+
  scale_fill_npg() +
  labs(x=NULL,fill="Sexo",y="%",title="Gênero dos Respondentes")+
  coord_polar("y", start=0)

A maior parte das respondentes se identifica como do sexo feminino.

library(psych)
describe(ds$Age_1)
##    vars   n mean    sd median trimmed   mad min max range skew kurtosis   se
## X1    1 270 39.9 14.24   37.5   38.75 14.08  17  78    61 0.66    -0.23 0.87
ggplot(ds, aes(x=Age_1)) + 
  geom_histogram(aes(y=..density..),binwidth = 1, color="grey",fill="grey")+
  geom_density(alpha=.2, fill="green")+
  geom_vline(aes(xintercept=mean(Age_1,na.rm=T)),color="blue",linetype="dashed",size=1)+
  labs(title="Idade dos Respondentes",y=NULL,x="Idade")

A média de idade dos reposndentes é de 39.9 anos de idade, com um desvio-padrão de 14.24 e a distribuição parece que “skew” para os jovens.

ds$Ethnic.f <- factor(ds$Ethnic, levels = c(0,1,2,3,4,5,6), 
                      labels = c("American Indian", "East Asian", "South Asian", "Black", "Hispanic","White", "Other"))
t.ethnic <- freq(ds$Ethnic.f, digits = 2, exclude = NA, total = T)
kable(t.ethnic, caption = "Distribuição de Respondentes por Etnia")
Distribuição de Respondentes por Etnia
n %
American Indian 1 0.37
East Asian 5 1.85
South Asian 4 1.48
Black 51 18.89
Hispanic 30 11.11
White 179 66.30
Other 0 0.00
Total 270 100.00

A amostra é, predominantemente, branca.

Renda

Embora renda seja parte da caracterização da amostra, eu resolvi separar a análise porque é uma variável de especial interesse nosso.

#Convertendo a escala de SES "Escada" em uma variável numérica
ds$ladder <- ifelse (ds$sesladder_1 == "On", 1, 
             ifelse (ds$sesladder_2 == "On", 2,
             ifelse (ds$sesladder_3 == "On", 3,
             ifelse (ds$sesladder_4 == "On", 4,
             ifelse (ds$sesladder_5 == "On", 5,
             ifelse (ds$sesladder_6 == "On", 6,
             ifelse (ds$sesladder_7 == "On", 7,
             ifelse (ds$sesladder_8 == "On", 8,
             ifelse (ds$sesladder_9 == "On", 9,
             ifelse (ds$sesladder_10 == "On", 10, NA))))))))))

require(questionr)
t.ladder <- freq(ds$ladder, digits = 2, exclude = NA, total = T)
kable(t.ladder, caption = "Distribuição das Posiçoẽs na Escada de SES")
Distribuição das Posiçoẽs na Escada de SES
n %
1 21 7.78
2 27 10.00
3 36 13.33
4 23 8.52
5 42 15.56
6 47 17.41
7 34 12.59
8 19 7.04
9 14 5.19
10 7 2.59
Total 270 100.00 
# Tratando a Escada de SES como uma variável intervalar
m.ladder <- psych::describe(ds$ladder)
rownames(m.ladder) <- "Escada SES"
kable(round(m.ladder[,c(2:4)],2), caption = "Média de Colocação na Escada de SES")
Média de Colocação na Escada de SES
n mean sd
Escada SES 270 5.01 2.36 
ds$SESlikert.f <- factor(ds$SESlikert, levels = c(1:5), labels = c("Lower class", "Lower middle class", "Middle class",
                                                                   "Upper middle class", "Upper class"))
t.SESLikert <- freq(ds$SESlikert.f, digits = 2, exclude = NA, total = T)
kable(t.SESLikert, caption = "Social Economic Class")
Social Economic Class
n %
Lower class 38 14.07
Lower middle class 82 30.37
Middle class 110 40.74
Upper middle class 34 12.59
Upper class 6 2.22
Total 270 100.00 
ds$Income.f <- factor(ds$Income, levels = c(1:8), labels = c("$15,000 or less", "$15,001-$25,000",  "$25,001-$35,000",
                                                             "$35,001-$50,000", "$50,001-$75,000",  "$75,001-$100,000",
                                                             "$100,001-$150,000",   "more than $150,000"))
t.Income <- freq(ds$Income.f, digits = 2, exclude = NA, total = T)
kable(t.Income, caption = "Distribuição de Renda dos Respondentes")
Distribuição de Renda dos Respondentes
n %
$15,000 or less 26 9.63
$15,001-$25,000 31 11.48
$25,001-$35,000 38 14.07
$35,001-$50,000 48 17.78
$50,001-$75,000 52 19.26
$75,001-$100,000 41 15.19
$100,001-$150,000 19 7.04
more than $150,000 15 5.56
Total 270 100.00 
#Fazendo um histograma da Renda, para visualizar a distribuição
ggplot(ds, aes(x=Income)) + 
  geom_histogram(aes(y=..density..),binwidth = 1, color="lightgrey",fill="lightgrey")+
  geom_density(alpha=.2, fill="magenta")+
  labs(title="Distribuição das faixas de Renda",y=NULL,x="Renda")

Exploração das Variáveis de Medida de Consumo (em $)

n.gastos <- c("Lunch","Movies", "Streaming", "Trips", "Concert", "Museums", "Parties", "Church", "BBQ", "GameEvents", 
              "BodyCare", "Sports","Games","Drinking","Exercise", "Language", "Creativity", "Conferences", "Therapy", "Career",
              "OwnEducation", "RelativeEducation","Healthcare")

m.freq.gasto <- describe(ds[,c(20:42)])
rownames(m.freq.gasto) <- n.gastos
m.freq.gasto.ordered <- m.freq.gasto[order(-m.freq.gasto$mean), ]
kable(round(m.freq.gasto.ordered[,c(3:4)],2), caption = "Média de Frequência de Gastos com Experiências")
Média de Frequência de Gastos com Experiências
mean sd
Streaming 3.71 1.26
Lunch 3.35 1.07
BBQ 3.28 1.09
Trips 3.27 1.08
BodyCare 3.15 1.26
Healthcare 3.09 1.24
Movies 2.94 1.16
Games 2.93 1.30
Exercise 2.76 1.32
Drinking 2.66 1.32
Parties 2.66 1.20
OwnEducation 2.63 1.31
Concert 2.52 1.16
Career 2.50 1.39
Museums 2.34 1.22
GameEvents 2.31 1.28
Sports 2.29 1.25
Church 2.23 1.30
Creativity 2.16 1.29
Conferences 2.12 1.25
Therapy 2.10 1.28
RelativeEducation 1.93 1.25
Language 1.79 1.15 
m.happyexp <- describe(ds[,c(43:46)])
rownames(m.happyexp) <- c("Happiness with Exp Purchases","Happiness Spending Money on them", "How many dollars", "Like to have more money")
kable(round(m.happyexp[,c(3,4)],2), caption = "Médias de Felicidade com Compras Experienciais")
Médias de Felicidade com Compras Experienciais
mean sd
Happiness with Exp Purchases 3.88 1.05
Happiness Spending Money on them 3.83 0.96
How many dollars 415.78 2189.71
Like to have more money 4.23 0.95

Parece haver umna variação enorme no gasto com compras experienciais. Vou colocar isso em boxplot.

spent.out <- boxplot(ds$moneyspent)

spent.out$out
##  [1]   800  1500 34232  2500  1000  1000   800  2000  2000  4500  2000  1100
## [13]  1000  1000  1000 10000   700   800  1000  1000  1200

Quem gastou acima de 700 dólares é considerado um outlier. Teve um respondente que colocou 3.4232^{4} dólares! Claramente, alguém que digitou qualquer número.

Exploração das Variáveis de Medida de Consumo em Tempo

n.tempo <- c("Parks", "Reading", "Music", "Movies", "Chatting", "Instrument", "Games",
             "CollectiveSports", "IndividualSports", "FreeConcerts", "Museums", "FamilyParties", "ChurchParties",
             "Praying", "Studying", "LearningJob", "LearningFun", "Arts", "Volunteering")
m.exptime <- describe(ds[,c(48:66)])
rownames(m.exptime) <- n.tempo
m.freq.gasto.ordered <- m.freq.gasto[order(-m.freq.gasto$mean), ]
kable(round(m.freq.gasto.ordered[,c(3:4)],2), caption = "Média de Frequência de Gastos com Experiências")
Média de Frequência de Gastos com Experiências
mean sd
Streaming 3.71 1.26
Lunch 3.35 1.07
BBQ 3.28 1.09
Trips 3.27 1.08
BodyCare 3.15 1.26
Healthcare 3.09 1.24
Movies 2.94 1.16
Games 2.93 1.30
Exercise 2.76 1.32
Drinking 2.66 1.32
Parties 2.66 1.20
OwnEducation 2.63 1.31
Concert 2.52 1.16
Career 2.50 1.39
Museums 2.34 1.22
GameEvents 2.31 1.28
Sports 2.29 1.25
Church 2.23 1.30
Creativity 2.16 1.29
Conferences 2.12 1.25
Therapy 2.10 1.28
RelativeEducation 1.93 1.25
Language 1.79 1.15 
m.exptime.ordered <- m.exptime[order(-m.exptime$mean),]
kable(round(m.exptime.ordered[,c(3:4)],2), caption = "Média de Frequência de Tempo Gasto com Experiências")
Média de Frequência de Tempo Gasto com Experiências
mean sd
Music 4.00 0.98
Movies 3.85 0.99
Chatting 3.58 1.13
Games 3.52 1.15
LearningFun 3.27 1.13
Reading 3.19 1.25
FamilyParties 3.13 1.15
Parks 3.11 1.19
Praying 2.89 1.45
Arts 2.76 1.37
LearningJob 2.71 1.36
Studying 2.55 1.36
IndividualSports 2.48 1.38
FreeConcerts 2.44 1.22
ChurchParties 2.37 1.37
Museums 2.37 1.26
Volunteering 2.36 1.22
CollectiveSports 2.21 1.38
Instrument 2.02 1.29 
m.happytime <- describe(ds[,c(67:70)])
rownames(m.happytime) <- c("Happiness with Exp which spend time","Happiness Spending time on Free", "How many time", "Like to have more time")
kable(round(m.happytime[,c(3,4)],2), caption = "Médias de Felicidade com Compras Experienciais e Tempo")
Médias de Felicidade com Compras Experienciais e Tempo
mean sd
Happiness with Exp which spend time 4.12 0.96
Happiness Spending time on Free 4.29 0.87
How many time 56.05 125.01
Like to have more time 4.15 0.91

Assim como no caso do dinheiro, parece haver uma variação muito grande no tempo gasto com experiências.

out.time <- boxplot(ds$timespent1)

out.time$out
##  [1]  200  400  300  150  400  200  180  200  165  400  300  600 1200  160  200
## [16]  200 1000  460  120  150  168  672  200  300  250

Parece que a partir de 120 horas, as repostas são outliers.

Teste de Relações entre variáveis

# Juntando todas as variáveis de medidas para um teste de correlação

d.gastos <- data.frame(ds[,c(20:46)])
n.gastos <- c("Lunch","Movies", "Streaming", "Trips", "Concert", "Museums", "Parties", "Church", "BBQ", "GameEvents", 
              "BodyCare", "Sports","Games","Drinking","Exercise", "Language", "Creativity", "Conferences", "Therapy", "Career",
              "OwnEducation", "RelativeEducation","Healthcare","Happiness with Exp Purchases","Happiness Spending Money on them",
              "How many dollars", "Like to have more money")
names(d.gastos) <- n.gastos
require(corrplot)
cor_matrix_spent <- cor(d.gastos)

corrplot(cor_matrix_spent, type = "upper", 
         method = "square", 
         tl.col = "gray", tl.srt = 45, tl.cex = 0.5)

d.tempo <- data.frame(ds[,c(48:70)])
n.tempo <- c("Parks", "Reading", "Music", "Movies", "Chatting", "Instrument", "Games",
             "CollectiveSports", "IndividualSports", "FreeConcerts", "Museums", "FamilyParties", "ChurchParties",
             "Praying", "Studying", "LearningJob", "LearningFun", "Arts", "Volunteering",
             "Happiness with Exp which spend time","Happiness Spending time on Free", "How many time", "Like to have more time")
names(d.tempo) <- n.tempo
cor_matrix_time <- cor(d.tempo)
corrplot(cor_matrix_time, type = "upper", 
         method = "square", 
         tl.col = "gray", tl.srt = 45, tl.cex = 0.5)

Regressões (algumas)

Aqui eu testarei algumas regressões mais óbvias, centrando as variáveis nas suas médias para aumentar a interpretatividade dos resultados quando existirem interações.

Efeitos de gastos individuais na felicidade com compras experienciais.

library(sjPlot)
library(sjmisc)
library(sjlabelled)
require(Hmisc)

label(ds[,c(20:42)]) <- as.list(n.gastos[1:23])
m.gastos.happy <- lm(happyexppurchase ~ expmoney_1 + expmoney_2 +expmoney_3 +expmoney_4 +
                       expmoney_5 +expmoney_6 +expmoney_7 +expmoney_8 +expmoney_9 +
                       expmoney_10 +expmoney_11 +expmoney_12 +expmoney_13 +expmoney_14 +
                       expmoney_15 +expmoney_16 +expmoney_17 +expmoney_18 +expmoney_19 +
                       expmoney_20 +expmoney_21 +expmoney_22 +expmoney_23, data = ds)
summary(m.gastos.happy)
## 
## Call:
## lm(formula = happyexppurchase ~ expmoney_1 + expmoney_2 + expmoney_3 + 
##     expmoney_4 + expmoney_5 + expmoney_6 + expmoney_7 + expmoney_8 + 
##     expmoney_9 + expmoney_10 + expmoney_11 + expmoney_12 + expmoney_13 + 
##     expmoney_14 + expmoney_15 + expmoney_16 + expmoney_17 + expmoney_18 + 
##     expmoney_19 + expmoney_20 + expmoney_21 + expmoney_22 + expmoney_23, 
##     data = ds)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -3.3281 -0.4985  0.1352  0.6047  1.8510 
## 
## Coefficients:
##              Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  3.014235   0.287381  10.489   <2e-16 ***
## expmoney_1   0.190842   0.072593   2.629   0.0091 ** 
## expmoney_2   0.030502   0.070426   0.433   0.6653    
## expmoney_3  -0.056696   0.057826  -0.980   0.3278    
## expmoney_4  -0.019864   0.072403  -0.274   0.7840    
## expmoney_5  -0.074636   0.072540  -1.029   0.3045    
## expmoney_6  -0.073246   0.073634  -0.995   0.3208    
## expmoney_7  -0.053292   0.073461  -0.725   0.4689    
## expmoney_8  -0.043355   0.056483  -0.768   0.4435    
## expmoney_9   0.086519   0.074144   1.167   0.2444    
## expmoney_10  0.106520   0.070930   1.502   0.1344    
## expmoney_11  0.089451   0.064154   1.394   0.1645    
## expmoney_12  0.018705   0.077895   0.240   0.8104    
## expmoney_13  0.073933   0.059557   1.241   0.2156    
## expmoney_14 -0.097245   0.063847  -1.523   0.1290    
## expmoney_15  0.051373   0.060817   0.845   0.3991    
## expmoney_16  0.068714   0.085101   0.807   0.4202    
## expmoney_17 -0.088357   0.070621  -1.251   0.2121    
## expmoney_18  0.164615   0.072996   2.255   0.0250 *  
## expmoney_19 -0.007865   0.058934  -0.133   0.8939    
## expmoney_20 -0.023808   0.068424  -0.348   0.7282    
## expmoney_21 -0.123787   0.066301  -1.867   0.0631 .  
## expmoney_22 -0.083546   0.064293  -1.299   0.1950    
## expmoney_23  0.110068   0.061274   1.796   0.0737 .  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.9908 on 246 degrees of freedom
## Multiple R-squared:  0.1791, Adjusted R-squared:  0.1023 
## F-statistic: 2.333 on 23 and 246 DF,  p-value: 0.0007758
s.m.gastos.happy <- summary(m.gastos.happy)$coefficients

plot_model(m.gastos.happy, terms = rownames(s.m.gastos.happy)[s.m.gastos.happy[,4]<0.05], show.values = TRUE)

#comparando os resultados a uma regressão stepwise
require(MASS)

m.gastos.happy.step <- stepAIC(lm(happyexppurchase ~ expmoney_1 + expmoney_2 +expmoney_3 +expmoney_4 +
                       expmoney_5 +expmoney_6 +expmoney_7 +expmoney_8 +expmoney_9 +
                       expmoney_10 +expmoney_11 +expmoney_12 +expmoney_13 +expmoney_14 +
                       expmoney_15 +expmoney_16 +expmoney_17 +expmoney_18 +expmoney_19 +
                       expmoney_20 +expmoney_21 +expmoney_22 +expmoney_23, data = ds), direction = "both", trace = FALSE)

summary(m.gastos.happy.step)
## 
## Call:
## lm(formula = happyexppurchase ~ expmoney_1 + expmoney_6 + expmoney_10 + 
##     expmoney_11 + expmoney_14 + expmoney_18 + expmoney_21 + expmoney_23, 
##     data = ds)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -3.3116 -0.4823  0.1990  0.6212  1.7483 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  2.98905    0.23502  12.718  < 2e-16 ***
## expmoney_1   0.20848    0.06762   3.083  0.00227 ** 
## expmoney_6  -0.11594    0.06167  -1.880  0.06123 .  
## expmoney_10  0.09797    0.06020   1.627  0.10488    
## expmoney_11  0.08157    0.05688   1.434  0.15274    
## expmoney_14 -0.10095    0.05501  -1.835  0.06763 .  
## expmoney_18  0.15250    0.06587   2.315  0.02137 *  
## expmoney_21 -0.15118    0.05563  -2.717  0.00702 ** 
## expmoney_23  0.10543    0.05518   1.911  0.05715 .  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.9799 on 261 degrees of freedom
## Multiple R-squared:  0.1481, Adjusted R-squared:  0.122 
## F-statistic: 5.674 on 8 and 261 DF,  p-value: 1.179e-06
s.m.gastos.happy.step <- summary(m.gastos.happy.step)$coefficients

plot_model(m.gastos.happy.step, terms = rownames(s.m.gastos.happy.step)[s.m.gastos.happy.step[,4]<0.05], show.values = TRUE,
           title = "Influência das Atividades na Felicidade com Experiências")

O resultado do modelo com Stepwise é, previsivelmente, mais parcimonioso. Fazendo a mesma coisa para as outras variáveis dependentes deste bloco.

m.gastos.money.step <- stepAIC(lm(happymoney ~ expmoney_1 + expmoney_2 +expmoney_3 +expmoney_4 +
                       expmoney_5 +expmoney_6 +expmoney_7 +expmoney_8 +expmoney_9 +
                       expmoney_10 +expmoney_11 +expmoney_12 +expmoney_13 +expmoney_14 +
                       expmoney_15 +expmoney_16 +expmoney_17 +expmoney_18 +expmoney_19 +
                       expmoney_20 +expmoney_21 +expmoney_22 +expmoney_23, data = ds), direction = "both", trace = FALSE)

summary(m.gastos.money.step)
## 
## Call:
## lm(formula = happymoney ~ expmoney_1 + expmoney_4 + expmoney_7 + 
##     expmoney_12 + expmoney_14 + expmoney_15 + expmoney_17 + expmoney_21 + 
##     expmoney_22, data = ds)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -2.93353 -0.51815  0.07929  0.60500  2.01593 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  2.63134    0.21535  12.219  < 2e-16 ***
## expmoney_1   0.12924    0.06043   2.139  0.03339 *  
## expmoney_4   0.10052    0.05696   1.765  0.07878 .  
## expmoney_7   0.16712    0.05968   2.800  0.00549 ** 
## expmoney_12  0.08996    0.05859   1.535  0.12588    
## expmoney_14 -0.08889    0.05288  -1.681  0.09399 .  
## expmoney_15  0.10617    0.05000   2.123  0.03467 *  
## expmoney_17  0.07738    0.05353   1.446  0.14950    
## expmoney_21 -0.09587    0.05092  -1.883  0.06084 .  
## expmoney_22 -0.09369    0.05153  -1.818  0.07022 .  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.8757 on 260 degrees of freedom
## Multiple R-squared:  0.1878, Adjusted R-squared:  0.1597 
## F-statistic: 6.681 on 9 and 260 DF,  p-value: 1.326e-08
s.m.gastos.money.step <- summary(m.gastos.money.step)$coefficients
plot_model(m.gastos.money.step, terms = rownames(s.m.gastos.money.step)[s.m.gastos.money.step[,4]<0.05], show.values = TRUE,
           title = "Influência das Atividades na Felicidade com o Valor gasto com Experiências")

Verificando a influência da variável de gastos com a experiências na experiência de felicidade

summary(lm(happyexppurchase ~ moneyspent, data = ds))
## 
## Call:
## lm(formula = happyexppurchase ~ moneyspent, data = ds)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -2.8981 -0.8700  0.1275  1.1161  1.1295 
## 
## Coefficients:
##              Estimate Std. Error t value Pr(>|t|)    
## (Intercept) 3.870e+00  6.479e-02  59.724   <2e-16 ***
## moneyspent  2.851e-05  2.912e-05   0.979    0.328    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 1.046 on 268 degrees of freedom
## Multiple R-squared:  0.003565,   Adjusted R-squared:  -0.0001534 
## F-statistic: 0.9587 on 1 and 268 DF,  p-value: 0.3284
summary(lm(happymoney ~ moneyspent, data = ds))
## 
## Call:
## lm(formula = happymoney ~ moneyspent, data = ds)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -2.8300 -0.8226  0.1744  0.1853  1.1785 
## 
## Coefficients:
##              Estimate Std. Error t value Pr(>|t|)    
## (Intercept) 3.821e+00  5.916e-02  64.591   <2e-16 ***
## moneyspent  2.895e-05  2.659e-05   1.089    0.277    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.955 on 268 degrees of freedom
## Multiple R-squared:  0.004404,   Adjusted R-squared:  0.0006895 
## F-statistic: 1.186 on 1 and 268 DF,  p-value: 0.2772

Parece que o dinheiro gasto em experiências não influencia o quanto de felicidade é derivada das experiências. Talvez seja uma questão de existir um efeito moderador da renda. Vou testar isso primeiro com a variável de “escada”

ds$moneyspent.mc <- ds$moneyspent-mean(ds$moneyspent, na.rm = TRUE)
ds$ladder.mc <- ds$ladder-mean(ds$ladder, na.rm = TRUE)

summary(lm(happyexppurchase ~ moneyspent.mc*ladder.mc, data = ds))
## 
## Call:
## lm(formula = happyexppurchase ~ moneyspent.mc * ladder.mc, data = ds)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -3.0906 -0.6761  0.1236  0.9506  1.3280 
## 
## Coefficients:
##                           Estimate Std. Error t value Pr(>|t|)    
## (Intercept)              3.875e+00  6.523e-02  59.405   <2e-16 ***
## moneyspent.mc           -1.677e-05  9.128e-05  -0.184   0.8544    
## ladder.mc                5.449e-02  2.755e-02   1.978   0.0489 *  
## moneyspent.mc:ladder.mc  8.085e-06  1.915e-05   0.422   0.6733    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 1.042 on 266 degrees of freedom
## Multiple R-squared:  0.01808,    Adjusted R-squared:  0.007002 
## F-statistic: 1.632 on 3 and 266 DF,  p-value: 0.1822
summary(lm(happymoney ~ moneyspent.mc*ladder.mc, data = ds))
## 
## Call:
## lm(formula = happymoney ~ moneyspent.mc * ladder.mc, data = ds)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -3.1911 -0.6486  0.1345  0.5269  1.5164 
## 
## Coefficients:
##                           Estimate Std. Error t value Pr(>|t|)    
## (Intercept)              3.822e+00  5.846e-02  65.377  < 2e-16 ***
## moneyspent.mc           -4.901e-05  8.181e-05  -0.599 0.549640    
## ladder.mc                9.268e-02  2.469e-02   3.754 0.000214 ***
## moneyspent.mc:ladder.mc  1.396e-05  1.717e-05   0.813 0.416718    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.934 on 266 degrees of freedom
## Multiple R-squared:  0.05473,    Adjusted R-squared:  0.04407 
## F-statistic: 5.134 on 3 and 266 DF,  p-value: 0.001816

Embora não exista interação entre essas variáveis, parece existir um efeito principal da ladder em si. Os dois efeitos são positivos, ou seja, quanto mais “alto o lugar na escada social”, mais felizes com experiências compradas ($) os respondentes estão.

Efeitos de tempo gasto com atividades na felicidade com compras experienciais.

label(ds[,c(48:66)]) <- as.list(n.tempo[1:19])

m.tempo.happy.step <- stepAIC(lm(happytime1 ~ Exptime_1 + Exptime_2 + Exptime_3 + Exptime_4 + 
                                   Exptime_5 + Exptime_6 + Exptime_7 + Exptime_8 + Exptime_9 + 
                                   Exptime_10 + Exptime_11 + Exptime_12 + Exptime_13 + Exptime_14 + 
                                   Exptime_15 + Exptime_16 + Exptime_17 + Exptime_18 + Exptime_19, data = ds), 
                              direction = "both", trace = FALSE)

summary(m.tempo.happy.step)
## 
## Call:
## lm(formula = happytime1 ~ Exptime_2 + Exptime_3 + Exptime_6 + 
##     Exptime_12 + Exptime_13 + Exptime_14, data = ds)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -3.8377 -0.3311  0.1210  0.6257  1.5913 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  3.04939    0.27416  11.123  < 2e-16 ***
## Exptime_2    0.07197    0.04889   1.472  0.14221    
## Exptime_3    0.12284    0.06195   1.983  0.04842 *  
## Exptime_6   -0.10938    0.04755  -2.300  0.02223 *  
## Exptime_12   0.13403    0.05403   2.481  0.01374 *  
## Exptime_13   0.14774    0.05315   2.780  0.00584 ** 
## Exptime_14  -0.06979    0.04930  -1.416  0.15808    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.9181 on 263 degrees of freedom
## Multiple R-squared:  0.1069, Adjusted R-squared:  0.08649 
## F-statistic: 5.245 on 6 and 263 DF,  p-value: 4.021e-05
s.m.tempo.happy.step <- summary(m.tempo.happy.step)$coefficients

plot_model(m.tempo.happy.step, terms = rownames(s.m.tempo.happy.step)[s.m.tempo.happy.step[,4]<0.05], show.values = TRUE,
           title = "Influência do Tempo Gasto com Atividades na Felicidade com Experiências")

m.tempo.feel.step <- stepAIC(lm(happytime2 ~ Exptime_1 + Exptime_2 + Exptime_3 + Exptime_4 + 
                                   Exptime_5 + Exptime_6 + Exptime_7 + Exptime_8 + Exptime_9 + 
                                   Exptime_10 + Exptime_11 + Exptime_12 + Exptime_13 + Exptime_14 + 
                                   Exptime_15 + Exptime_16 + Exptime_17 + Exptime_18 + Exptime_19, data = ds), 
                              direction = "both", trace = FALSE)

summary(m.tempo.feel.step)
## 
## Call:
## lm(formula = happytime2 ~ Exptime_2 + Exptime_3 + Exptime_4 + 
##     Exptime_6 + Exptime_9 + Exptime_12 + Exptime_13 + Exptime_14 + 
##     Exptime_15 + Exptime_17, data = ds)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -3.9058 -0.3553  0.1100  0.5642  1.5706 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  2.84402    0.26680  10.660   <2e-16 ***
## Exptime_2    0.08402    0.04402   1.909   0.0574 .  
## Exptime_3    0.12066    0.05784   2.086   0.0379 *  
## Exptime_4    0.08054    0.05551   1.451   0.1481    
## Exptime_6   -0.08827    0.04489  -1.966   0.0503 .  
## Exptime_9    0.07710    0.04313   1.788   0.0750 .  
## Exptime_12   0.08576    0.05122   1.675   0.0952 .  
## Exptime_13   0.09046    0.04791   1.888   0.0601 .  
## Exptime_14  -0.07099    0.04482  -1.584   0.1144    
## Exptime_15  -0.09056    0.04544  -1.993   0.0473 *  
## Exptime_17   0.09765    0.05426   1.800   0.0731 .  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.8118 on 259 degrees of freedom
## Multiple R-squared:  0.1675, Adjusted R-squared:  0.1354 
## F-statistic: 5.213 on 10 and 259 DF,  p-value: 5.673e-07
s.m.tempo.feel.step <- summary(m.tempo.feel.step)$coefficients

plot_model(m.tempo.feel.step, terms = rownames(s.m.tempo.feel.step)[s.m.tempo.feel.step[,4]<0.05], show.values = TRUE,
           title = "Influência do Tempo Gasto com Atividades na Felicidade")

Renda e Felicidade com Experiências Gratuítas

model.freecost <- lm(happytime2 ~ ladder.mc, data = ds) #Com a "escada"
summary(model.freecost)
## 
## Call:
## lm(formula = happytime2 ~ ladder.mc, data = ds)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -3.3712 -0.3136 -0.1697  0.7151  0.8303 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  4.28519    0.05307  80.745   <2e-16 ***
## ladder.mc    0.02878    0.02252   1.278    0.202    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.872 on 268 degrees of freedom
## Multiple R-squared:  0.006056,   Adjusted R-squared:  0.002348 
## F-statistic: 1.633 on 1 and 268 DF,  p-value: 0.2024
model.freecost2 <- lm(happytime2 ~ SESlikert, data = ds) #Com SES likert
summary(model.freecost2)
## 
## Call:
## lm(formula = happytime2 ~ SESlikert, data = ds)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -3.3079 -0.2918 -0.2597  0.7082  0.7403 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  4.24369    0.15379  27.595   <2e-16 ***
## SESlikert    0.01605    0.05581   0.288    0.774    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.8746 on 268 degrees of freedom
## Multiple R-squared:  0.0003085,  Adjusted R-squared:  -0.003422 
## F-statistic: 0.08269 on 1 and 268 DF,  p-value: 0.7739
model.freecost3 <- lm(happytime2 ~ Income, data = ds) #Com a renda declarada
summary(model.freecost3)
## 
## Call:
## lm(formula = happytime2 ~ Income, data = ds)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -3.4569 -0.3533 -0.1346  0.6812  0.8654 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  4.08861    0.12871  31.766   <2e-16 ***
## Income       0.04603    0.02747   1.676    0.095 .  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.8701 on 268 degrees of freedom
## Multiple R-squared:  0.01037,    Adjusted R-squared:  0.006675 
## F-statistic: 2.808 on 1 and 268 DF,  p-value: 0.09498