data.frame(

image1 = c(

'Oats',

'Oats',

'Oats',

'Oats',

'Green Beens',

'Green Beens',

'Green Beens',

'Green Beens'

),

image2 = c(

'Cellery',

'Jungle Pellet',

'Peanuts',

'Carrot',

'Cellery',

'Jungle Pellet',

'Peanuts',

'Carrot'

)

)

prob_chip <-

get_probabilities_df(

m2_chip,

newdata = pairs_chip,

model_type = 'bt') #here we are assuming zero for the random effects

prob_macaque <-

get_probabilities_df(

m2_macaque,

newdata = pairs_macaque,

model_type = 'bt')

prob_chip

prob_macaque <-

get_probabilities_df(

m2_macaque,

newdata = pairs_macaque,

model_type = 'bt')

pairs_macaque

pairs_macaque <-

data.frame(

image1 = c(

'Oats',

'Oats',

'Oats',

'Oats',

'Green Beans',

'Green Beans',

'Green Beans',

'Green Beans'

),

image2 = c(

'Celery',

'Jungle Pellet',

'Peanuts',

'Carrot',

'Celery',

'Jungle Pellet',

'Peanuts',

'Carrot'

)

)

prob_macaque <-

get_probabilities_df(

m2_macaque,

newdata = pairs_macaque,

model_type = 'bt')

prob_gor <-

get_probabilities_df(

m2_macaque,

newdata = pairs_gor,

model_type = 'bt')

prob_chip

load_all("../bpcs")

load_all("../bpcs")

m2_gor

# Create a data frame with all the pairs of food that we want to calculate

pairs_gor <-

data.frame(

image1 = c(

'Apple',

'Apple',

'Apple',

'Apple',

'Tomato',

'Tomato',

'Tomato',

'Tomato'

),

image2 = c(

'Cucumber',

'Grape',

'Turnip',

'Carrot',

'Cucumber',

'Grape',

'Turnip',

'Carrot'

)

)

pairs_chip <-

data.frame(

image1 = c(

'Apple',

'Apple',

'Apple',

'Apple',

'Tomato',

'Tomato',

'Tomato',

'Tomato'

),

image2 = c(

'Cucumber',

'Grape',

'Turnip',

'Carrot',

'Cucumber',

'Grape',

'Turnip',

'Carrot'

)

)

pairs_macaque <-

data.frame(

image1 = c(

'Oats',

'Oats',

'Oats',

'Oats',

'Green Beans',

'Green Beans',

'Green Beans',

'Green Beans'

),

image2 = c(

'Celery',

'Jungle Pellet',

'Peanuts',

'Carrot',

'Celery',

'Jungle Pellet',

'Peanuts',

'Carrot'

)

)

prob_chip <-

get_probabilities_df(

m2_chip,

newdata = pairs_chip,

model_type = 'bt') #here we are assuming zero for the random effects

prob_macaque <-

get_probabilities_df(

m2_macaque,

newdata = pairs_macaque,

model_type = 'bt')

prob_gor <-

get_probabilities_df(

m2_gor,

newdata = pairs_gor,

model_type = 'bt')

#merging in a single df

prob_table <- rbind(prob_gor, prob_chip, prob_macaque)

#since this is a time consuming table to make let's also save it

saveRDS(prob_table_df, 'prob_table.RDS')

prob_gor

#since this is a time consuming table to make let's also save it

saveRDS(prob_table, 'prob_table.RDS')

prob_table <- prob_table %>%

mutate(Probability = i_beats_j,

OddsRatio = Probability/(1-Probability))

prob_table %>%

dplyr::select(i,j,Probability,OddsRatio) %>%

kable(caption='Posterior probabilities of the novel stimuli i being selected over the trained stimuli j',

booktabs=T,

digits=2,

col.names = c('Item i', 'Item j', 'Probability', 'Odds Ratio')) %>%

kableExtra::kable_styling() %>%

kableExtra::pack_rows("Gorilla", 1, 8) %>%

kableExtra::pack_rows("Chimpanzee", 9, 16) %>%

kableExtra::pack_rows("Macaque", 17, 24)

prob_table %>%

dplyr::select(i,j,Probability,OddsRatio) %>%

kable(format='latex',

caption='Posterior probabilities of the novel stimuli i being selected over the trained stimuli j',

booktabs=T,

digits=2,

col.names = c('Item i', 'Item j', 'Probability', 'Odds Ratio')) %>%

kableExtra::kable_styling() %>%

kableExtra::pack_rows("Gorilla", 1, 8) %>%

kableExtra::pack_rows("Chimpanzee", 9, 16) %>%

kableExtra::pack_rows("Macaque", 17, 24)

d<-read.table("data/MHLC.txt", sep="\t", header=T)

d<-as.data.frame(d)

sample_n(d, size=5) %>%

kable(caption = 'Sample of rows from the original data')

d <- d %>% mutate(SubjectID = row_number())

cols_to_pivot<-colnames(d)[1:10]

d_longer<-tidyr::pivot_longer(d, cols=all_of(cols_to_pivot), names_to='comparison', values_to='y')

comp_cols <- str_split_fixed(d_longer$comparison, "", 2)

d_longer$choice0 <- comp_cols[,1]

d_longer$choice1 <- comp_cols[,2]

dplyr::sample_n(d_longer, size=10) %>%

kable()

#choice0

d_longer$choice0 <- recode(d_longer$choice0, 'A'='Active')

d_longer$choice0 <- recode(d_longer$choice0, 'B'='Active-Collaborative')

d_longer$choice0 <- recode(d_longer$choice0, 'C'='Collaborative')

d_longer$choice0 <- recode(d_longer$choice0, 'D'='Passive-Collaborative')

d_longer$choice0 <- recode(d_longer$choice0, 'E'='Passive')

#choice1

d_longer$choice1 <- recode(d_longer$choice1, 'A'='Active')

d_longer$choice1 <- recode(d_longer$choice1, 'B'='Active-Collaborative')

d_longer$choice1 <- recode(d_longer$choice1, 'C'='Collaborative')

d_longer$choice1 <- recode(d_longer$choice1, 'D'='Passive-Collaborative')

d_longer$choice1 <- recode(d_longer$choice1, 'E'='Passive')

d_longer <- d_longer %>%

mutate(Internal = scale(MHLC_INTERNAL),

Chance = scale(MHLC_CHANCE),

Doctors = scale(MHLC_DOCTORS),

OtherPeople = scale(MHLC_OTHER_PEOPLE))

m3 <- load_bpc_model('fittedmodels/m_mhloc_subjectpred_U.RDS')

d_longer

colnames(d_longer)

d_longer$choice0

newdata <- tibble::tribble(~choice0, ~choice1, ~Internal, ~Chance, ~Doctors, ~OtherPeople,

"Active", "Passive", 0, 0, 0, 0,

"Active", "Passive", -2, 0, 0, 0,

"Active", "Passive", 2, 0, 0, 0,

"Active", "Passive", 0, 0, -2, 0,

"Active", "Passive", 0, 0, 2, 0,

"Active-Collaborative", "Collaborative", 0, 0, 0, 0,

"Active-Collaborative", "Collaborative", -2, 0, 0, 0,

"Active-Collaborative", "Collaborative", 2, 0, 0, 0,

"Active-Collaborative", "Collaborative", 0, 0, -2, 0,

"Active-Collaborative", "Collaborative", 0, 0, 2, 0,

"Collaborative", "Passive-Collaborative", 0, 0, 0, 0,

"Collaborative", "Passive-Collaborative", 0, -2, 0, 0,

"Collaborative", "Passive-Collaborative", 0, 2, 0, 0,

"Collaborative", "Passive-Collaborative", 0, 0, 0, -2,

"Collaborative", "Passive-Collaborative", 0, 0, 0, 2

)

newdata <- tibble::tribble(~choice0, ~choice1, ~Internal, ~Chance, ~Doctors, ~OtherPeople,

"Active", "Passive", 0, 0, 0, 0,

"Active", "Passive", -2, 0, 0, 0,

"Active", "Passive", 2, 0, 0, 0,

"Active", "Passive", 0, 0, -2, 0,

"Active", "Passive", 0, 0, 2, 0,

"Active-Collaborative", "Collaborative", 0, 0, 0, 0,

"Active-Collaborative", "Collaborative", -2, 0, 0, 0,

"Active-Collaborative", "Collaborative", 2, 0, 0, 0,

"Active-Collaborative", "Collaborative", 0, 0, -2, 0,

"Active-Collaborative", "Collaborative", 0, 0, 2, 0,

"Collaborative", "Passive-Collaborative", 0, 0, 0, 0,

"Collaborative", "Passive-Collaborative", 0, -2, 0, 0,

"Collaborative", "Passive-Collaborative", 0, 2, 0, 0,

"Collaborative", "Passive-Collaborative", 0, 0, 0, -2,

"Collaborative", "Passive-Collaborative", 0, 0, 0, 2

)

#Now we can calculate the probabilities

prob_hloc <-

get_probabilities_df(

m3,

newdata = newdata,

model_type = 'bt-subjectpredictors') #here we are assuming zero for the random effects

m3

m3$stanfit

m3$stanfit$`S[1,2]

``

m3$stanfit$`S[1,1]`

m3$stanfit$`S[1,1]`

m3$stanfit

s<=m3$stanfit

s<-m3$stanfit

s

s$`S[1,1]`

s[.`S[1,1]`]

s[,`S[1,1]`]

s[`S[1,1]`,]

load_all("../bpcs")

#Now we can calculate the probabilities

prob_hloc <-

get_probabilities_df(

m3,

newdata = newdata,

model_type = 'bt-subjectpredictors') #here we are assuming zero for the random effects

load_all("../bpcs")

get_probabilities_df(

m3,

newdata = newdata,

model_type = 'bt-subjectpredictors')

m3$call_arg$subject_predictors <- c('Internal', 'Chance', 'Doctors', 'OtherPeople')

load_all("../bpcs")

#Now we can calculate the probabilities

prob_hloc <-

get_probabilities_df(

m3,

newdata = newdata,

model_type = 'bt-subjectpredictors') #here we are assuming zero for the random effects

save_bpc_model(m3, 'm_mhloc_subjectpred_U', 'fittedmodels')

prob_hloc

load_all("../bpcs")

#Now we can calculate the probabilities

prob_hloc <-

get_probabilities_df(

m3,

newdata = newdata,

model_type = 'bt-subjectpredictors') #here we are assuming zero for the random effects

load_all("../bpcs")

#Now we can calculate the probabilities

prob_hloc <-

get_probabilities_df(

m3,

newdata = newdata,

model_type = 'bt-subjectpredictors') #here we are assuming zero for the random effects

load_all("../bpcs")

#Now we can calculate the probabilities

prob_hloc <-

get_probabilities_df(

m3,

newdata = newdata,

model_type = 'bt-subjectpredictors') #here we are assuming zero for the random effects

load_all("../bpcs")

#Now we can calculate the probabilities

prob_hloc <-

get_probabilities_df(

m3,

newdata = newdata,

model_type = 'bt-subjectpredictors') #here we are assuming zero for the random effects

load_all("../bpcs")

#Now we can calculate the probabilities

prob_hloc <-

get_probabilities_df(

m3,

newdata = newdata,

model_type = 'bt-subjectpredictors') #here we are assuming zero for the random effects

prob_hloc

load_all("../bpcs")

#Now we can calculate the probabilities

prob_hloc <-

get_probabilities_df(

m3,

newdata = newdata,

model_type = 'bt-subjectpredictors') #here we are assuming zero for the random effects

kable(prob_hloc,

caption = "Probabilities of selecting between the different roles based on changes of the values of the HLOC dimensions",

digits = 2,

booktabs = T)

prob_hloc %>%

select(-j_beats_i) %>%

rename(i_beats_j='Probability') %>%

kable(caption = "Probabilities of selecting between the different roles based on changes of the values of the HLOC dimensions",

digits = 2,

booktabs = T)

prob_hloc %>%

select(-j_beats_i) %>%

rename(Probability=i_beats_j) %>%

kable(caption = "Probabilities of selecting between the different roles based on changes of the values of the HLOC dimensions",

digits = 2,

booktabs = T)

prob_hloc %>%

select(-j_beats_i) %>%

rename(Probability=i_beats_j) %>%

kable(caption = "Probabilities of selecting role i instead of j based on changes of the values of the HLOC dimensions",

digits = 2,

booktabs = T)

prob_hloc %>%

select(-j_beats_i) %>%

rename(Probability=i_beats_j) %>%

kable(caption = "Probabilities of selecting role i instead of j based on changes of the values of the HLOC dimensions",

digits = 2,

booktabs = T) %>%

kableExtra::add_header_above(c("Roles" = 2, "HLOC dimensions" = 4))

prob_hloc %>%

select(-j_beats_i) %>%

rename(Probability=i_beats_j) %>%

kable(caption = "Probabilities of selecting role i instead of j based on changes of the values of the HLOC dimensions",

digits = 2,

booktabs = T) %>%

kableExtra::add_header_above(c("Roles" = 2, "HLOC dimensions" = 4, " "=1))

prob_hloc %>%

select(-j_beats_i) %>%

rename(Probability=i_beats_j) %>%

kable(

format='latex',

caption = "Probabilities of selecting role i instead of j based on changes of the values of the HLOC dimensions",

digits = 2,

booktabs = T) %>%

kableExtra::add_header_above(c("Roles" = 2, "HLOC dimensions" = 4, " "=1))

prob_hloc %>%

select(-j_beats_i) %>%

rename(Probability=i_beats_j) %>%

kable(

format='latex',

caption = "Probabilities of selecting role i instead of j based on changes of the values of the HLOC dimensions",

digits = 3,

booktabs = T) %>%

kableExtra::add_header_above(c("Roles" = 2, "HLOC dimensions" = 4, " "=1))

prob_hloc %>%

select(-j_beats_i) %>%

rename(Probability=i_beats_j) %>%

kable(

format='latex',

caption = "Probabilities of selecting role i instead of j based on changes of the values of the HLOC dimensions",

digits = 2,

booktabs = T) %>%

kableExtra::add_header_above(c("Roles" = 2, "HLOC dimensions" = 4, " "=1))

prob_hloc$i <- recode(prob_hloc$i, 'Active-Collaborative'='Act.-Collab.')

prob_hloc$i <- recode(prob_hloc$i, 'Collaborative'='Collab.')

prob_hloc$j <- recode(prob_hloc$j, 'Collaborative'='Collab.')

prob_hloc$j <- recode(prob_hloc$j, 'Passive-Collaborative'='Pass.-Collab.')

prob_hloc %>%

select(-j_beats_i) %>%

rename(Probability=i_beats_j) %>%

kable(

format='latex',

caption = "Probabilities of selecting role i instead of j based on changes of the values of the HLOC dimensions",

digits = 2,

booktabs = T) %>%

kableExtra::add_header_above(c("Roles" = 2, "HLOC dimensions" = 4, " "=1))

bookdown::render_book()

bookdown::render_book('index.Rmd', 'all')

library(bpcs)

library(tidyverse)

options(mc.cores = parallel::detectCores())

rstan::rstan_options(auto_write = TRUE)

set.seed(99)

d <- readxl::read_xlsx('data/moisture.xlsx', sheet = 'Exp02_BTmodel')

sample_n(d, size = 5) %>%

kable(caption = 'Sample of the original data')

library(bpcs)

library(tidyverse)

library(knitr)

options(mc.cores = parallel::detectCores())

rstan::rstan_options(auto_write = TRUE)

set.seed(99)

d <- readxl::read_xlsx(path='data/PREF_DATA.xlsx', sheet = 'Pizza')

sample_n(d, size=5) %>%

kable(caption="Example of the pizza data frame")

dpizza <- expand_aggregated_data(d = d, player0 = 'Prod1', player1 = 'Prod2', wins0 = 'Win1', wins1 = 'Win2', keep=NULL)

# renaming the columns

colnames(dpizza) <- c('Prod0','Prod1', 'y', 'contest_id')

# creating a short table to exemplify

sample_n(dpizza, size = 10) %>%

kable(caption = 'Sample of the expanded pizza data set')

m <- load_bpc_model('fittedmodels/pizza.RDS')

#posterior predictive check

y_pp <- posterior_predictive(m)

posterior_predictive(m)

library(devtools)

load_all("../bpcs/")

m$predictors_matrix

load_all("../bpcs/")

#posterior predictive check

y_pp <- posterior_predictive(m)

load_all("../bpcs/")

#posterior predictive check

y_pp <- posterior_predictive(m)

predict(m,newdata = d)

d

m <- bpc(data = dpizza,

player0 = 'Prod0',

player1 = 'Prod1',

result_column = 'y',

solve_ties = 'none',

model_type = 'bt',

iter=3000)

save_bpc_model(m, 'pizza','fittedmodels')

#posterior predictive check

y_pp <- posterior_predictive(m)

load_all("../bpcs/")

#posterior predictive check

y_pp <- posterior_predictive(m)

y <- y_pp$y

y_pred <- y_pp$y_pred

bookdown::render_book('index.Rmd', 'all')

bookdown::render_book('index.Rmd', 'all')

clean_cache(clean = T)

knitr::opts_chunk$get('cache.path')

bookdown::render_book('index.Rmd', 'all')

library(bpcs)

library(tidyverse)

library(knitr)

options(mc.cores = parallel::detectCores())

rstan::rstan_options(auto_write = TRUE)

set.seed(99)

d <- readxl::read_xlsx(path='data/PREF_DATA.xlsx', sheet = 'Pizza')

sample_n(d, size=5) %>%

kable(caption="Example of the pizza data frame")

dpizza <- expand_aggregated_data(d = d, player0 = 'Prod1', player1 = 'Prod2', wins0 = 'Win1', wins1 = 'Win2', keep=NULL)

# renaming the columns

colnames(dpizza) <- c('Prod0','Prod1', 'y', 'contest_id')

# creating a short table to exemplify

sample_n(dpizza, size = 10) %>%

kable(caption = 'Sample of the expanded pizza data set')

m <- load_bpc_model('fittedmodels/pizza.RDS')

#posterior predictive check

y_pp <- posterior_predictive(m)

#posterior predictive check

y_pp <- posterior_predictive(m)

y <- y_pp$y

y_pred <- y_pp$y_pred

bookdown::render_book('index.Rmd', 'all')

bookdown::render_book('index.Rmd', 'all')

bookdown::render_book('index.Rmd', 'all')

bookdown::render_book('index.Rmd', 'all')

bookdown::render_book('index.Rmd', 'all')

bookdown::render_book('index.Rmd', 'html_book')

bookdown::render_book('index.Rmd', 'gitbook')

bookdown::render_book("index.Rmd", "bookdown::gitbook")

citation('ggplot2')

citation('kableExtra')