Chargement du fichier de données (1 fichier = 1 sujet)
# The raw data files can be downloaded on https://github.com/vincentberthet/Judgmental-bootstrapping
d <- read.csv2(file.choose())
head(d)
## date time subject blocknum blockcode trialcode trialnum
## 1 52216 11:42:04 SB 1 expé stimulus 1
## 2 52216 11:42:04 SB 1 expé stimulus 2
## 3 52216 11:42:04 SB 1 expé stimulus 3
## 4 52216 11:42:04 SB 1 expé stimulus 4
## 5 52216 11:42:04 SB 1 expé stimulus 5
## 6 52216 11:42:04 SB 1 expé stimulus 6
## values.situation values.market_growthnumber
## 1 Situation n°31 4
## 2 Situation n°32 5
## 3 Situation n°33 3
## 4 Situation n°34 1
## 5 Situation n°35 4
## 6 Situation n°36 4
## values.market_growth values.market_concentrationnumber
## 1 Croissance du marché: Plutôt forte 4
## 2 Croissance du marché: Forte 4
## 3 Croissance du marché: Moyenne 5
## 4 Croissance du marché: Faible 3
## 5 Croissance du marché: Plutôt forte 4
## 6 Croissance du marché: Plutôt forte 3
## values.market_concentration values.market_sharenumber
## 1 Concentration du marché: Plutôt forte 3
## 2 Concentration du marché: Plutôt forte 4
## 3 Concentration du marché: Forte 4
## 4 Concentration du marché: Moyenne 3
## 5 Concentration du marché: Plutôt forte 3
## 6 Concentration du marché: Moyenne 2
## values.market_share values.relative_costnumber
## 1 Votre part de marché (rang): 3ème 4
## 2 Votre part de marché (rang): 4ème 1
## 3 Votre part de marché (rang): 4ème 4
## 4 Votre part de marché (rang): 3ème 3
## 5 Votre part de marché (rang): 3ème 4
## 6 Votre part de marché (rang): 2ème 4
## values.relative_cost
## 1 Coût relatif de votre offre: Plus élevé que la concurrence
## 2 Coût relatif de votre offre: Beaucoup plus faible que la concurrence
## 3 Coût relatif de votre offre: Plus élevé que la concurrence
## 4 Coût relatif de votre offre: Equivalent à celui de la concurrence
## 5 Coût relatif de votre offre: Plus élevé que la concurrence
## 6 Coût relatif de votre offre: Plus élevé que la concurrence
## values.relative_qualitynumber
## 1 3
## 2 1
## 3 4
## 4 5
## 5 1
## 6 5
## values.relative_quality
## 1 Qualité relative de votre offre: Equivalente à la concurrence
## 2 Qualité relative de votre offre: Très inférieure à la concurrence
## 3 Qualité relative de votre offre: Supérieure à la concurrence
## 4 Qualité relative de votre offre: Très supérieure à la concurrence
## 5 Qualité relative de votre offre: Très inférieure à la concurrence
## 6 Qualité relative de votre offre: Très supérieure à la concurrence
## values.standardizationnumber values.standardization response latency
## 1 1 Produits standardisés: Oui 5 26049
## 2 2 Produits standardisés: Non 7 8428
## 3 1 Produits standardisés: Oui 3 20273
## 4 1 Produits standardisés: Oui 3 14580
## 5 2 Produits standardisés: Non 5 15858
## 6 1 Produits standardisés: Oui 3 14829
Stats descriptives des réponses du sujet
library(psych)
describe(d$response)
## vars n mean sd median trimmed mad min max range skew kurtosis se
## 1 1 50 4.6 1.81 4.5 4.67 2.22 1 7 6 -0.12 -1.17 0.26
tmp <- hist(d$response, breaks=0:(max(d$response)), xaxt="n", main="", xlab="")
axis(1, at=tmp$mids, labels=1:max(d$response))
Régression linéaire des réponses du sujet sur les six indices
model <- lm(d$response ~ d$values.market_growthnumber + d$values.market_concentrationnumber + d$values.market_sharenumber + d$values.relative_costnumber + d$values.relative_qualitynumber + d$values.standardizationnumber, data=d)
summary(model)
##
## Call:
## lm(formula = d$response ~ d$values.market_growthnumber + d$values.market_concentrationnumber +
## d$values.market_sharenumber + d$values.relative_costnumber +
## d$values.relative_qualitynumber + d$values.standardizationnumber,
## data = d)
##
## Residuals:
## Min 1Q Median 3Q Max
## -2.02782 -0.76644 0.04592 0.70070 1.63959
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 10.64911 1.00848 10.560 1.61e-13
## d$values.market_growthnumber -0.32315 0.14561 -2.219 0.0318
## d$values.market_concentrationnumber -0.05563 0.13339 -0.417 0.6787
## d$values.market_sharenumber 0.19704 0.13628 1.446 0.1555
## d$values.relative_costnumber -0.73024 0.15065 -4.847 1.67e-05
## d$values.relative_qualitynumber -0.99213 0.13688 -7.248 5.63e-09
## d$values.standardizationnumber -0.18877 0.31350 -0.602 0.5502
##
## (Intercept) ***
## d$values.market_growthnumber *
## d$values.market_concentrationnumber
## d$values.market_sharenumber
## d$values.relative_costnumber ***
## d$values.relative_qualitynumber ***
## d$values.standardizationnumber
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.075 on 43 degrees of freedom
## Multiple R-squared: 0.6897, Adjusted R-squared: 0.6464
## F-statistic: 15.93 on 6 and 43 DF, p-value: 1.55e-09
Judgmental bootstrapping
bootstrap <- list()
n <- 25 # nombre d'observations par sous-échantillon : 25
x <- 1000 # nombre de répétitions : 1000
for (k in 1:x) {
bootstrap[[k]] <- list()
# subset 1
rand <- sample(1:nrow(d), n, replace=FALSE)
subset1 <- d[rand,]
model1 <- lm(subset1$response ~ subset1$values.market_growthnumber + subset1$values.market_concentrationnumber + subset1$values.market_sharenumber + subset1$values.relative_costnumber + subset1$values.relative_qualitynumber + subset1$values.standardizationnumber, data=subset1)
summary(model1)
# subset 2
v <- rep(0,nrow(d))
for (i in 1:length(v)) {v[i] <- ifelse(i %in% rand == 'TRUE', 0, i)}
subset2 <- d[v[!v %in% 0],]
pred_reg <- rep(0,nrow(subset2))
pred_moy <- rep(0,nrow(subset2))
for (i in 1:nrow(subset2)) {
pred_reg[i] <- subset2$values.market_growthnumber[i]*coefficients(model1)[2] + subset2$values.market_concentrationnumber[i]*coefficients(model1)[3] + subset2$values.market_sharenumber[i]*coefficients(model1)[4] + subset2$values.relative_costnumber[i]*coefficients(model1)[5] + subset2$values.relative_qualitynumber[i]*coefficients(model1)[6] + subset2$values.standardizationnumber[i]*coefficients(model1)[7] + coefficients(model1)[1]
}
cor(pred_reg,subset2$response)
#
bootstrap[[k]] <- list(model1 = model1, pred = data.frame(subset2$response,pred_reg), test = cor(pred_reg,subset2$response))
}
##
coeff_market_growthnumber <- rep(0,length(x))
coeff_market_concentrationnumber <- rep(0,length(x))
coeff_market_sharenumber <- rep(0,length(x))
coeff_relative_costnumber <- rep(0,length(x))
coeff_relative_qualitynumber <- rep(0,length(x))
coeff_standardizationnumber <- rep(0,length(x))
test <- rep(0,length(x))
for (i in 1:x) {
coeff_market_growthnumber[i] <- bootstrap[[i]]$model1$coefficients[2]
coeff_market_concentrationnumber[i] <- bootstrap[[i]]$model1$coefficients[3]
coeff_market_sharenumber[i] <- bootstrap[[i]]$model1$coefficients[4]
coeff_relative_costnumber[i] <- bootstrap[[i]]$model1$coefficients[5]
coeff_relative_qualitynumber[i] <- bootstrap[[i]]$model1$coefficients[6]
coeff_standardizationnumber[i] <- bootstrap[[i]]$model1$coefficients[7]
test[i] <- bootstrap[[i]]$test
}
confint(model, level=0.95)
## 2.5 % 97.5 %
## (Intercept) 8.61531788 12.6829064
## d$values.market_growthnumber -0.61679532 -0.0295102
## d$values.market_concentrationnumber -0.32463194 0.2133742
## d$values.market_sharenumber -0.07778701 0.4718763
## d$values.relative_costnumber -1.03406140 -0.4264162
## d$values.relative_qualitynumber -1.26817231 -0.7160962
## d$values.standardizationnumber -0.82099837 0.4434524
describe(test)
## vars n mean sd median trimmed mad min max range skew kurtosis
## 1 1 1000 0.74 0.07 0.76 0.75 0.06 0.46 0.89 0.42 -0.97 1.15
## se
## 1 0
hist(test, main="", xlab="")
