experiment consumers
fabrizio
2022-04-07
Risk
dAll3 <- bind_rows(dKE %>% select(FL_risk.1.player.C_1:FL_risk.1.player.C_10) %>% mutate(country="KE"),
dMA %>% select(FL_risk.1.player.C_1:FL_risk.1.player.C_10) %>% mutate(country="MO"),
dUG %>% select(FL_risk.1.player.C_1:FL_risk.1.player.C_10) %>% mutate(country="UG"),
dTN %>% select(FL_risk.1.player.C_1:FL_risk.1.player.C_10) %>% mutate(country="TN"),
dTZ %>% select(FL_risk.1.player.C_1:FL_risk.1.player.C_10) %>% mutate(country="TZ"))
dAll3$pattern=paste(dAll3$FL_risk.1.player.C_1,dAll3$FL_risk.1.player.C_2,dAll3$FL_risk.1.player.C_3,
dAll3$FL_risk.1.player.C_4,dAll3$FL_risk.1.player.C_5,dAll3$FL_risk.1.player.C_6,
dAll3$FL_risk.1.player.C_7,dAll3$FL_risk.1.player.C_8,dAll3$FL_risk.1.player.C_9,dAll3$FL_risk.1.player.C_10,sep="")
# patterns classification
dAll3b <- dAll3
dAll3b$countB <- NA
dAll3b$tipo <- NA
for(i in 1:nrow(dAll3b)){
tipo=0
nB=NA
G1=gregexpr("AB",dAll3b$pattern[i])[[1]]
G2=gregexpr("BA",dAll3b$pattern[i])[[1]]
if(length(G1)>1 | (G1[1]>0 & G2[1]>0)){tipo=1}
if(tipo==0 & length(G2)==1 & G2[1]>0){tipo=2}
if(tipo==0){
G3=gregexpr("B",dAll3b$pattern[i])[[1]]
if(G3[1]==-1){
nB=0
} else {
nB=length(gregexpr("B",dAll3b$pattern[i])[[1]])
}
}
dAll3b$countB[i] <- nB
dAll3b$tipo[i] <- tipo
}
tR1 <- bind_rows(dAll3b %>% mutate(type=factor(tipo,labels = c("switch_A.B","mixed","switch_B.A"))) %>%
group_by(country,type) %>% count() %>% spread(type,n),
dAll3b %>% mutate(type=factor(tipo,labels = c("switch_A.B","mixed","switch_B.A"))) %>%
mutate(country="Total") %>%
group_by(country,type) %>% count() %>% spread(type,n)) %>%
mutate(Total=switch_A.B+ mixed+ switch_B.A) %>%
mutate('valid.%'=round(switch_A.B/Total*100,1))
my.flextb(tR1,title = "Risk: switch types")country | switch_A.B | mixed | switch_B.A | Total | valid.% |
KE | 282 | 221 | 5 | 508 | 55.5 |
MO | 496 | 4 | 1 | 501 | 99.0 |
TN | 412 | 87 | 3 | 502 | 82.1 |
TZ | 375 | 143 | 2 | 520 | 72.1 |
UG | 196 | 296 | 8 | 500 | 39.2 |
Total | 1,761 | 751 | 19 | 2,531 | 69.6 |
tR2 <- bind_rows(dAll3b %>% filter(tipo==0) %>% select(country,pattern,countB) %>%
group_by(country) %>%
summarise(n=n(),avg=round(mean(countB),2),stDev=round(sd(countB),2),median=median(countB)),
dAll3b %>% mutate(country="Total") %>% filter(tipo==0) %>% select(country,pattern,countB) %>%
group_by(country) %>%
summarise(n=n(),avg=round(mean(countB),2),stDev=round(sd(countB),2),median=median(countB)))
my.flextb(tR2,title = "Risk taking")country | n | avg | stDev | median |
KE | 282 | 4.24 | 3.27 | 3 |
MO | 496 | 4.74 | 1.83 | 5 |
TN | 412 | 4.79 | 2.23 | 5 |
TZ | 375 | 4.80 | 2.39 | 5 |
UG | 196 | 4.99 | 4.74 | 5 |
Total | 1,761 | 4.71 | 2.75 | 5 |
# Plots with only switch.type = switch_A_B
dAll3b %>% filter(!is.na(countB)) %>%
ggplot(aes(x=countB))+
geom_histogram(binwidth = 1,center=0,fill="gray75",color="gray50")+
scale_x_continuous(breaks = seq(from=0,to=10,by=1))+theme_bw()+
xlab("Risk taking scores")+
facet_wrap(~country,nrow = 1) +
theme(axis.text.x = element_text(size=11),
strip.text.x = element_text(size = 11),
plot.title = element_text(size=16),
plot.title.position = "plot")+
labs(title = "Risk preferences - Distribution of risk-taking scores by country")
dAll3b %>% filter(!is.na(countB)) %>%
ggplot(aes(x=countB))+
geom_histogram(binwidth = 1,center=0,fill="gray75",color="gray50")+
scale_x_continuous(breaks = seq(from=0,to=10,by=1))+theme_bw()+
xlab("Risk taking scores")+
theme(axis.text.x = element_text(size=11),
strip.text.x = element_text(size = 11),
plot.title = element_text(size=16),
plot.title.position = "plot")+
labs(title = "Risk preferences - Distribution of risk-taking scores")
dAll3b %>% filter(!is.na(countB)) %>% select(1:11) %>%
pivot_longer(1:10,names_to="Lottery",values_to="Choice") %>%
mutate(Lottery=factor(as.integer(substr(Lottery,20,21))),
Choice=factor(Choice,levels = c("A","B"))) %>%
group_by(country,Lottery,Choice) %>%
summarise(n=n()) %>% mutate(perc=n/sum(n)*100) %>%
ggplot(aes(x=Lottery,y=perc,fill=Choice))+
geom_bar(stat="identity")+
facet_wrap(~country,nrow = 1)+
scale_fill_brewer(palette="Set1",direction = -1) +
ylab("%")+xlab("")+
theme_bw()+
theme(axis.text.x = element_text(size=11),
strip.text.x = element_text(size = 11),
plot.title = element_text(size=16),
plot.title.position = "plot")+
ggtitle("Risk preferences - Lottery choice by country")
dAll3b %>% filter(!is.na(countB)) %>% select(1:11) %>%
pivot_longer(1:10,names_to="Lottery",values_to="Choice") %>%
mutate(Lottery=factor(as.integer(substr(Lottery,20,21))),
Choice=factor(Choice,levels = c("A","B"))) %>%
group_by(country,Lottery,Choice) %>%
summarise(n=n()) %>% mutate(perc=n/sum(n)*100) %>%
ggplot(aes(x=Lottery,y=perc,fill=Choice))+
geom_bar(stat="identity")+
scale_fill_brewer(palette="Set1",direction = -1) +
ylab("%")+xlab("")+
theme_bw()+
theme(axis.text.x = element_text(size=11),
strip.text.x = element_text(size = 11),
plot.title = element_text(size=16),
plot.title.position = "plot")+
ggtitle("Risk preferences - Lottery choice by country")
Time
dAll4 <- bind_rows(dKE %>% select(FL_time.1.player.C_1:FL_time.1.player.C_10) %>% mutate(country="KE"),
dMA %>% select(FL_time.1.player.C_1:FL_time.1.player.C_10) %>% mutate(country="MO"),
dUG %>% select(FL_time.1.player.C_1:FL_time.1.player.C_10) %>% mutate(country="UG"),
dTN %>% select(FL_time.1.player.C_1:FL_time.1.player.C_10) %>% mutate(country="TN"),
dTZ %>% select(FL_time.1.player.C_1:FL_time.1.player.C_10) %>% mutate(country="TZ"))
dAll4$pattern=paste(dAll4$FL_time.1.player.C_1,dAll4$FL_time.1.player.C_2,dAll4$FL_time.1.player.C_3,
dAll4$FL_time.1.player.C_4,dAll4$FL_time.1.player.C_5,dAll4$FL_time.1.player.C_6,
dAll4$FL_time.1.player.C_7,dAll4$FL_time.1.player.C_8,dAll4$FL_time.1.player.C_9,dAll4$FL_time.1.player.C_10,sep="")
# pattern classification
dAll4b <- dAll4
dAll4b$countB <- NA
dAll4b$tipo <- NA
for(i in 1:nrow(dAll4b)){
tipo=0
nB=NA
G1=gregexpr("AB",dAll4b$pattern[i])[[1]]
G2=gregexpr("BA",dAll4b$pattern[i])[[1]]
if(length(G1)>1 | (G1[1]>0 & G2[1]>0)){tipo=1}
if(tipo==0 & length(G2)==1 & G2[1]>0){tipo=2}
if(tipo==0){
G3=gregexpr("B",dAll4b$pattern[i])[[1]]
if(G3[1]==-1){
nB=0
} else {
nB=length(gregexpr("B",dAll4b$pattern[i])[[1]])
}
}
dAll4b$countB[i] <- nB
dAll4b$tipo[i] <- tipo
}
tT1 <- bind_rows(dAll4b %>% mutate(type=factor(tipo,labels = c("switch_A.B","mixed","switch_B.A"))) %>%
group_by(country,type) %>% count() %>% spread(type,n,fill = 0),
dAll4b %>% mutate(type=factor(tipo,labels = c("switch_A.B","mixed","switch_B.A"))) %>%
mutate(country="Total") %>%
group_by(country,type) %>% count() %>% spread(type,n,fill = 0)) %>%
mutate(Total=switch_A.B+ mixed+ switch_B.A) %>%
mutate('valid.%'=round(switch_A.B/Total*100,1))
my.flextb(tT1,title = "Time: switch types")country | switch_A.B | mixed | switch_B.A | Total | valid.% |
KE | 355 | 152 | 1 | 508 | 69.9 |
MO | 491 | 10 | 0 | 501 | 98.0 |
TN | 466 | 35 | 1 | 502 | 92.8 |
TZ | 395 | 122 | 3 | 520 | 76.0 |
UG | 331 | 166 | 3 | 500 | 66.2 |
Total | 2,038 | 485 | 8 | 2,531 | 80.5 |
tT2 <- bind_rows(dAll4b %>% filter(tipo==0) %>% select(country,pattern,countB) %>%
group_by(country) %>%
summarise(n=n(),avg=round(mean(countB),2),stDev=round(sd(countB),2),median=median(countB)),
dAll4b %>% mutate(country="Total") %>% filter(tipo==0) %>% select(country,pattern,countB) %>%
group_by(country) %>%
summarise(n=n(),avg=round(mean(countB),2),stDev=round(sd(countB),2),median=median(countB)))
my.flextb(tT2,title = "Time: patience score")country | n | avg | stDev | median |
KE | 355 | 5.75 | 3.18 | 6 |
MO | 491 | 5.40 | 3.15 | 5 |
TN | 466 | 5.87 | 3.10 | 6 |
TZ | 395 | 6.70 | 4.15 | 9 |
UG | 331 | 6.39 | 4.30 | 9 |
Total | 2,038 | 5.98 | 3.59 | 6 |
# Plots with only switch.type = switch_A_B
dAll4b %>% filter(!is.na(countB)) %>%
ggplot(aes(x=countB))+
geom_histogram(binwidth = 1,center=0,fill="gray75",color="gray50")+
scale_x_continuous(breaks = seq(from=0,to=10,by=1))+theme_bw()+
xlab("patience scores")+
facet_wrap(~country,nrow = 1) +
theme(axis.text.x = element_text(size=11),
strip.text.x = element_text(size = 11),
plot.title = element_text(size=16),
plot.title.position = "plot")+
labs(title = "Time preferences - Distribution of patience scores by country")
dAll4b %>% filter(!is.na(countB)) %>%
ggplot(aes(x=countB))+
geom_histogram(binwidth = 1,center=0,fill="gray75",color="gray50")+
scale_x_continuous(breaks = seq(from=0,to=10,by=1))+theme_bw()+
xlab("Patience scores")+
theme(axis.text.x = element_text(size=11),
strip.text.x = element_text(size = 11),
plot.title = element_text(size=16),
plot.title.position = "plot")+
labs(title = "Time preferences - Distribution of patience scores")
dAll4b %>% filter(!is.na(countB)) %>% select(1:11) %>%
pivot_longer(1:10,names_to="Lottery",values_to="Choice") %>%
mutate(Lottery=factor(as.integer(substr(Lottery,20,21))),
Choice=factor(Choice,levels = c("A","B"))) %>%
group_by(country,Lottery,Choice) %>%
summarise(n=n()) %>% mutate(perc=n/sum(n)*100) %>%
ggplot(aes(x=Lottery,y=perc,fill=Choice))+
geom_bar(stat="identity")+
facet_wrap(~country,nrow = 1)+
scale_fill_brewer(palette="Set1",direction = -1) +
ylab("%")+xlab("")+
theme_bw()+
theme(axis.text.x = element_text(size=11),
strip.text.x = element_text(size = 11),
plot.title = element_text(size=16),
plot.title.position = "plot")+
ggtitle("Frequency of choice by Prospect and country")
dAll4b %>% filter(!is.na(countB)) %>% select(1:11) %>%
pivot_longer(1:10,names_to="Lottery",values_to="Choice") %>%
mutate(Lottery=factor(as.integer(substr(Lottery,20,21))),
Choice=factor(Choice,levels = c("A","B"))) %>%
group_by(country,Lottery,Choice) %>%
summarise(n=n()) %>% mutate(perc=n/sum(n)*100) %>%
ggplot(aes(x=Lottery,y=perc,fill=Choice))+
geom_bar(stat="identity")+
scale_fill_brewer(palette="Set1",direction = -1) +
ylab("%")+xlab("")+
theme_bw()+
theme(axis.text.x = element_text(size=11),
strip.text.x = element_text(size = 11),
plot.title = element_text(size=16),
plot.title.position = "plot")+
ggtitle("Frequency of choice by Prospect")
PGG - Public Good Game
dAll <- bind_rows(dKE %>% select(FL_PGG.1.player.contribution,FL_PGG.1.group.id_in_subsession,FL_PGG.2.player.contribution) %>% mutate(country="KE"),
dMA %>% select(FL_PGG.1.player.contribution,FL_PGG.1.group.id_in_subsession,FL_PGG.2.player.contribution) %>% mutate(country="MO"),
dUG %>% select(FL_PGG.1.player.contribution,FL_PGG.1.group.id_in_subsession,FL_PGG.2.player.contribution) %>% mutate(country="UG"),
dTN %>% select(FL_PGG.1.player.contribution,FL_PGG.1.group.id_in_subsession,FL_PGG.2.player.contribution) %>% mutate(country="TN"),
dTZ %>% select(FL_PGG.1.player.contribution,FL_PGG.1.group.id_in_subsession,FL_PGG.2.player.contribution) %>% mutate(country="TZ"))
tmp <- bind_rows(dAll %>% select(contribution=FL_PGG.1.player.contribution,country) %>% mutate(round="round.1"),
dAll %>% select(contribution=FL_PGG.2.player.contribution,country) %>% mutate(round="round.2")) %>% filter(!is.na(contribution))
tmp %>% ggplot(aes(x=contribution))+
geom_histogram(aes(y=..density..),fill="gray75" ,colour="gray50", binwidth = 10,boundary = 0)+
facet_wrap(~country+round,ncol = 4)+
theme_bw()+
theme(axis.text.x = element_text(size=11),
strip.text.x = element_text(size = 11),
plot.title = element_text(size=16),
plot.title.position = "plot")+
ggtitle("Ammount of tokens contributed to the common account in the Public Good Game by country and round")
# dAll <- dAll %>% filter(!is.na(FL_PGG.1.player.contribution) & !is.na(FL_PGG.2.player.contribution))
tb.PGG <- bind_rows(dAll %>% group_by(country) %>% summarise(n=n(),
contribution_round.1=round(mean(FL_PGG.1.player.contribution,na.rm=T),1),
contribution_round.2=round(mean(FL_PGG.2.player.contribution,na.rm=T),1)),
dAll %>% mutate(country="Total") %>% group_by(country) %>% summarise(n=n(),
contribution_round.1=round(mean(FL_PGG.1.player.contribution,na.rm=T),1),
contribution_round.2=round(mean(FL_PGG.2.player.contribution,na.rm=T),1)))
my.flextb(tb.PGG,title = "Average amount of tokens contributed to the common account by round")country | n | contribution_round.1 | contribution_round.2 |
KE | 508 | 62.8 | 62.6 |
MO | 501 | 73.1 | 70.1 |
TN | 502 | 77.4 | 78.5 |
TZ | 520 | ||
UG | 500 | 75.4 | 77.6 |
Total | 2,531 | 72.4 | 72.4 |
tmp <- bind_rows(dAll %>% select(contribution=FL_PGG.1.player.contribution,country) %>% mutate(round="round.1"),
dAll %>% select(contribution=FL_PGG.2.player.contribution,country) %>% mutate(round="round.2")) %>%
filter(!is.na(contribution)) %>% mutate(round=factor(round),country=factor(country)) %>% as.data.frame()
tbPGG.test <- test3way(var1 = "country",var2 = "round",var3 = "contribution",data = tmp,test = "wilcox.test") %>% select(-3)
my.flextb(tbPGG.test,title = "Wilcoxon test on amount of tokens contributed to the common account by round")country | statistic | p.value | Signif |
KE | 30,998 | 0.8741 | |
MO | 35,881 | 0.2782 | |
TN | 35,403 | 0.7721 | |
UG | 38,073 | 0.5510 | |
Total | 560,451 | 0.8943 |
dAll <- dAll %>% filter(!is.na(FL_PGG.1.group.id_in_subsession))
tb.PGG2 <- bind_rows(
dAll %>%
group_by(country) %>% summarise(n=n(),
contribution_round.1=mean(FL_PGG.1.player.contribution,na.rm=T),
contribution_round.2=mean(FL_PGG.2.player.contribution,na.rm=T),
sd.round.1=sd(FL_PGG.1.player.contribution,na.rm=T),
sd.round.2=sd(FL_PGG.2.player.contribution,na.rm=T)),
dAll %>% mutate(country="Total") %>%
group_by(country) %>% summarise(n=n(),
contribution_round.1=mean(FL_PGG.1.player.contribution,na.rm=T),
contribution_round.2=mean(FL_PGG.2.player.contribution,na.rm=T),
sd.round.1=sd(FL_PGG.1.player.contribution,na.rm=T),
sd.round.2=sd(FL_PGG.2.player.contribution,na.rm=T))) %>%
mutate(SE.contribution.1=sd.round.1/sqrt(n),
SE.contribution.2=sd.round.2/sqrt(n))
tb.PGG2 %>% select(1,3,4,7,8) %>% gather("round","value",2:3) %>%
mutate(SE=ifelse(round=="contribution_round.1",SE.contribution.1,SE.contribution.2)) %>%
mutate(country=factor(country,levels = c("KE","MO","TN","UG","Total"))) %>%
ggplot(aes(x=country,y=value,fill=round))+
geom_bar(stat="identity",position = "dodge")+
geom_errorbar(aes(ymin=value-SE, ymax=value+SE), width=.2,
position=position_dodge(.9))+
scale_fill_brewer(palette = "Set1","")+
ylab("contribution")+xlab("")+
theme_bw()+
theme(axis.text.x = element_text(size=11),
plot.title = element_text(size=16),
plot.title.position = "plot")+
labs(title = "Amount of tokens contributed to the common account by round and country",
subtitle = "Average value with standard error")
DG - Dictator game
# dAll2 <- bind_rows(dKE %>% select(FL_DG.1.player.id_in_group,FL_DG.1.player.sent,FL_DG.1.player.sent_inst,FL_DG.1.player.type) %>% mutate(country="KE"),
# dMA %>% select(FL_DG.1.player.id_in_group,FL_DG.1.player.sent,FL_DG.1.player.sent_inst,FL_DG.1.player.type) %>% mutate(country="MO"),
# dUG %>% select(FL_DG.1.player.id_in_group,FL_DG.1.player.sent,FL_DG.1.player.sent_inst,FL_DG.1.player.type) %>% mutate(country="UG"))
dAll2 <- bind_rows(dKE %>% select(FL_DG.1.player.id_in_group,FL_DG.1.player.sent,FL_DG.1.player.sent_inst,FL_DG.1.player.type) %>% mutate(country="KE"),
dMA %>% select(FL_DG.1.player.id_in_group,FL_DG.1.player.sent,FL_DG.1.player.sent_inst,FL_DG.1.player.type) %>% mutate(country="MO"),
dUG %>% select(FL_DG.1.player.id_in_group,FL_DG.1.player.sent,FL_DG.1.player.sent_inst,FL_DG.1.player.type) %>% mutate(country="UG"),
dTN %>% select(FL_DG.1.player.id_in_group,FL_DG.1.player.sent,FL_DG.1.player.sent_inst,FL_DG.1.player.type) %>% mutate(country="TN"),
dTZ %>% select(FL_DG.1.player.id_in_group,FL_DG.1.player.sent,FL_DG.1.player.sent_inst,FL_DG.1.player.type) %>% mutate(country="TZ"))
dAll2 %>% filter(!is.na(FL_DG.1.player.id_in_group)) %>% select(country,FL_DG.1.player.sent,FL_DG.1.player.sent_inst) %>%
gather("sent","value",2:3) %>%
ggplot(aes(x=value))+
geom_histogram(binwidth = 10,boundary=0,fill="gray75",color="gray50")+
theme_bw()+
facet_wrap(~sent)+
theme(axis.text.x = element_text(size=11),
strip.text.x = element_text(size = 11),
plot.title = element_text(size=16),
plot.title.position = "plot")+
ggtitle("DG - Contribution sent to the receiver")
dAll2 %>% filter(!is.na(FL_DG.1.player.id_in_group)) %>% select(country,FL_DG.1.player.sent,FL_DG.1.player.sent_inst) %>%
gather("sent","value",2:3) %>%
ggplot(aes(x=value))+
geom_histogram(binwidth = 10,boundary=0,fill="gray75",color="gray50")+
theme_bw()+
facet_wrap(~country+sent,ncol=2)+
theme(axis.text.x = element_text(size=11),
strip.text.x = element_text(size = 11),
plot.title = element_text(size=16),
plot.title.position = "plot")+
ggtitle("DG - Contribution sent to the receiver by country")
TDG1 <- summaryExt3way(var1 = "country",var2 = "FL_DG.1.player.type",var3 = "FL_DG.1.player.sent",simplify = F,
data = dAll2 %>% filter(!is.na(FL_DG.1.player.type)) %>% as.data.frame()) %>%
select(1:3,avg.sent=5,stDev.sent=6,median.sent=9)
TDG2 <- summaryExt3way(var1 = "country",var2 = "FL_DG.1.player.type",var3 = "FL_DG.1.player.sent_inst",simplify = F,
data = dAll2 %>% filter(!is.na(FL_DG.1.player.type)) %>% as.data.frame()) %>%
select(avg.sent_inst=5,stDev.sent_inst=6,median.sent_inst=9)
tDGa <- bind_cols(TDG1,TDG2) %>% filter(FL_DG.1.player.type=="Subtotal" | FL_DG.1.player.type=="Total") %>% select(-2)
my.flextb(tDGa,title = "Contribution sent to the receiver and institution by country")country | n | avg.sent | stDev.sent | median.sent | avg.sent_inst | stDev.sent_inst | median.sent_inst |
KE | 240 | 33.0 | 24.6 | 25.0 | 31.0 | 25.2 | 25 |
MO | 240 | 40.4 | 22.1 | 42.5 | 38.8 | 23.9 | 30 |
TN | 234 | 40.2 | 26.0 | 50.0 | 45.2 | 28.2 | 50 |
TZ | 520 | 41.7 | 23.5 | 50.0 | 48.3 | 24.2 | 50 |
UG | 220 | 46.5 | 23.3 | 50.0 | 52.5 | 25.5 | 50 |
Total | 1,454 | 40.5 | 24.1 | 50.0 | 44.0 | 26.1 | 50 |
tmpDG <- dAll2 %>% filter(!is.na(FL_DG.1.player.id_in_group)) %>% select(country,FL_DG.1.player.sent,FL_DG.1.player.sent_inst) %>%
gather("sent","value",2:3) %>% as.data.frame()
tDGb <- test3way(var1 = "country",var2 = "sent",var3 = "value",data = tmpDG,test = "wilcox.test")
my.flextb(tDGb,title = "Wilcox test on difference between contribution sent to receiver and to institution by country")country | statistic | df | p.value | Signif |
KE | 30,159.0 | 0.3599 | ||
MO | 30,285.5 | 0.3172 | ||
TN | 25,178.5 | 0.1211 | ||
TZ | 115,709.0 | 2.2e-05 | *** | |
UG | 20,941.5 | 0.0113 | * | |
Total | 985,582.0 | 0.0011 | ** |
left_join(summaryExt3way(var1 = "country",var2 = "FL_DG.1.player.type",var3 = "FL_DG.1.player.sent",simplify = F,statRid = F,digits = 2,
data = dAll2 %>% filter(!is.na(FL_DG.1.player.type)) %>% as.data.frame()) %>%
filter(FL_DG.1.player.type=="Subtotal" | FL_DG.1.player.type=="Total") %>%
select(country,avg.sent=Mean,SE.sent=st.Err),
summaryExt3way(var1 = "country",var2 = "FL_DG.1.player.type",var3 = "FL_DG.1.player.sent_inst",simplify = F,statRid = F,digits = 2,
data = dAll2 %>% filter(!is.na(FL_DG.1.player.type)) %>% as.data.frame()) %>%
filter(FL_DG.1.player.type=="Subtotal" | FL_DG.1.player.type=="Total") %>%
select(country,avg.sent_inst=Mean,SE.sent_inst=st.Err),by="country") %>%
gather("avg","value",c(2,4)) %>%
mutate(country=factor(country,levels = c("KE","MO","TN","TZ","UG","Total"))) %>%
mutate(avg=factor(avg,labels = c("sent_receiver","sent_inst"))) %>%
mutate(SE=ifelse(avg=="avg.sent",SE.sent,SE.sent_inst)) %>%
ggplot(aes(x=country,y=value,fill=avg))+
geom_bar(stat="identity",position = "dodge")+
geom_errorbar(aes(ymin=value-SE, ymax=value+SE), width=.2,
position=position_dodge(.9))+
scale_fill_brewer(palette = "Set1","")+
ylab("contribution")+xlab("")+
theme_bw()+
theme(axis.text.x = element_text(size=11),
plot.title = element_text(size=16),
plot.title.position = "plot")+
labs(title = "Contribution sent to receiver and to institution by country",
subtitle = "Average value with standard error")
TG - Trust
# dAll5 <- bind_rows(dKE %>% select(FL_TG.1.player.recipr_0:FL_TG.1.player.recipr_4,FL_TG.1.player.payoff,FL_TG.1.player.type,FL_TG.1.player.payoff_inst) %>% mutate(country="KE"),
# dMA %>% select(FL_TG.1.player.recipr_0:FL_TG.1.player.recipr_4,FL_TG.1.player.payoff,FL_TG.1.player.type,FL_TG.1.player.payoff_inst) %>% mutate(country="MO"),
# dUG %>% select(FL_TG.1.player.recipr_0:FL_TG.1.player.recipr_4,FL_TG.1.player.payoff,FL_TG.1.player.type,FL_TG.1.player.payoff_inst) %>% mutate(country="UG"))
# # dTN %>% select(FL_TG.1.player.recipr_0:FL_TG.1.player.recipr_4,FL_TG.1.player.payoff,FL_TG.1.player.type,FL_TG.1.player.payoff_inst) %>% mutate(country="KE"))
dAll5 <- bind_rows(dKE %>% select(FL_TG.1.player.recipr_0:FL_TG.1.player.recipr_4,FL_TG.1.player.payoff,FL_TG.1.player.type,FL_TG.1.player.payoff_inst) %>% mutate(country="KE"),
dMA %>% select(FL_TG.1.player.recipr_0:FL_TG.1.player.recipr_4,FL_TG.1.player.payoff,FL_TG.1.player.type,FL_TG.1.player.payoff_inst) %>% mutate(country="MO"),
dUG %>% select(FL_TG.1.player.recipr_0:FL_TG.1.player.recipr_4,FL_TG.1.player.payoff,FL_TG.1.player.type,FL_TG.1.player.payoff_inst) %>% mutate(country="UG"),
dTN %>% select(FL_TG.1.player.recipr_0:FL_TG.1.player.recipr_4,FL_TG.1.player.payoff,FL_TG.1.player.type,FL_TG.1.player.payoff_inst) %>% mutate(country="TN"),
dTZ %>% select(FL_TG.1.player.recipr_0:FL_TG.1.player.recipr_4,FL_TG.1.player.payoff,FL_TG.1.player.type,FL_TG.1.player.payoff_inst) %>% mutate(country="TZ"))
dAll5 %>% filter(!is.na(FL_TG.1.player.type)) %>%
select(country,FL_TG.1.player.type,FL_TG.1.player.recipr_0:FL_TG.1.player.recipr_4) %>%
gather("recipr","value",3:7) %>%
mutate(recipr=factor(recipr,labels = 0:4)) %>%
ggplot(aes(x=value))+
geom_histogram(binwidth = 25,boundary=0,fill="gray75",color="gray50")+
facet_wrap(~recipr,ncol = 5)+
theme_bw()+
theme(axis.text.x = element_text(size=11),
strip.text.x = element_text(size = 11),
plot.title = element_text(size=16),
plot.title.position = "plot")+
ggtitle("Returned tokens by trust levels")
dAll5 %>% filter(!is.na(FL_TG.1.player.type)) %>%
select(country,FL_TG.1.player.type,FL_TG.1.player.recipr_0:FL_TG.1.player.recipr_4) %>%
gather("recipr","value",3:7) %>%
mutate(recipr=factor(recipr,labels = 0:4)) %>%
filter(recipr!="0") %>%
ggplot(aes(x=value))+
geom_histogram(binwidth = 25,boundary=0,fill="gray75",color="gray50")+
facet_wrap(~country+recipr,ncol = 4)+
theme_bw()+
theme(axis.text.x = element_text(size=11),
strip.text.x = element_text(size = 11),
plot.title = element_text(size=16),
plot.title.position = "plot")+
ggtitle("Returned tokens by trust levels and country")
tmpTG <- dAll5 %>% filter(!is.na(FL_TG.1.player.type)) %>%
select(country,FL_TG.1.player.type,FL_TG.1.player.recipr_0:FL_TG.1.player.recipr_4) %>%
gather("recipr","value",3:7) %>%
mutate(recipr=factor(recipr,labels = 0:4))
# dAll5 %>% filter(!is.na(FL_TG.1.player.type)) %>% group_by(country) %>% count()
tbTG1 <- tappFu(tmpTG$value,list(tmpTG$country,tmpTG$recipr),fun = mean) %>% round(digits = 1) %>% tibble::rownames_to_column("country")
my.flextb(tbTG1,title = "Mean")country | 0 | 1 | 2 | 3 | 4 | Total |
KE | 0 | 22.4 | 41.2 | 60.9 | 83.2 | 41.6 |
MO | 0 | 31.4 | 57.8 | 84.8 | 122.6 | 59.3 |
TN | 0 | 33.7 | 58.5 | 90.3 | 118.8 | 60.2 |
TZ | 0 | 42.6 | 77.5 | 119.6 | 158.7 | 79.7 |
UG | 0 | 32.2 | 62.2 | 92.4 | 123.8 | 62.1 |
Total | 0 | 34.2 | 62.6 | 94.9 | 128.0 | 63.9 |
tmpTG <- dAll5 %>% filter(!is.na(FL_TG.1.player.type)) %>%
select(country,FL_TG.1.player.type,FL_TG.1.player.recipr_0:FL_TG.1.player.recipr_4) %>%
gather("recipr","value",3:7) %>%
mutate(recipr=factor(recipr,labels = 0:4))
tbTG1 <- tappFu(tmpTG$value,list(tmpTG$country,tmpTG$recipr),fun = median) %>% tibble::rownames_to_column("country")
my.flextb(tbTG1,title = "Median")country | 0 | 1 | 2 | 3 | 4 | Total |
KE | 0 | 25 | 50 | 70 | 90 | 25 |
MO | 0 | 25 | 50 | 75 | 100 | 50 |
TN | 0 | 25 | 50 | 75 | 100 | 50 |
TZ | 0 | 50 | 75 | 100 | 150 | 50 |
UG | 0 | 25 | 50 | 80 | 100 | 50 |
Total | 0 | 25 | 50 | 75 | 100 | 50 |
tappFu(tmpTG$value,list(tmpTG$country,tmpTG$recipr),fun = mean) %>% round(digits = 1) %>% tibble::rownames_to_column("country") %>%
select(1,3:6) %>%
gather("recipr","value",2:5) %>%
mutate(country=factor(country,levels=c("KE","MO","TN","TZ","UG","Total"))) %>%
ggplot(aes(x=country,y=value,fill=country))+
geom_bar(stat="identity")+
scale_fill_brewer(palette = "Set2","")+
facet_wrap(~recipr)+
theme_bw() +
xlab("")+ylab("tokens")+
theme(axis.text.x = element_text(size=11),
strip.text.x = element_text(size = 11),
plot.title = element_text(size=16),
plot.title.position = "plot", legend.position = "none")+
labs(title = "Trust - average of tokens send back by trust level and country")
tappFu(tmpTG$value,list(tmpTG$country,tmpTG$recipr),fun = mean) %>% round(digits = 1) %>% tibble::rownames_to_column("country") %>%
select(1,3:6) %>%
gather("recipr","value",2:5) %>%
mutate(country=factor(country,levels=c("KE","MO","TN","TZ","UG","Total"))) %>%
ggplot(aes(x=recipr,y=value,fill=country))+
geom_bar(stat="identity")+
scale_fill_brewer(palette = "Set2","")+
facet_wrap(~country)+
theme_bw() +
xlab("")+ylab("tokens")+
theme(axis.text.x = element_text(size=11),
strip.text.x = element_text(size = 11),
plot.title = element_text(size=16),
plot.title.position = "plot", legend.position = "none")+
labs(title = "Trust - average of tokens send back by trust level and country")