library(shiny)
library(ggpubr)
set.seed(1234)
# shiny interface----------------------------------------------------
ui <- fluidPage(
includeScript("../../../Matomo-tquant.js"),
navbarPage("Crossmodal Response Enhancement",
tabPanel("Data generation",
fluidRow(
column(4,
h3("Visual"),
br(),
plotOutput('plotv', width = "100%", height = "400px")
),
column(4,
h3("Auditory"),
br(),
plotOutput('plota', width = "100%", height = "400px")
),
column(4,
h3("Crossmodal"),
br(),
plotOutput('plotc', width = "100%", height = "400px")
)),
fluidRow(
column(5, offset=0.5,
br(),
h3("Parameters"),
br(),
textOutput('parexpl')
),
column(6, offset = 1,
br(),
br(),
numericInput(inputId = "n",
label = "Number of trials to generate",
value = 20),
lambda_vis <- sliderInput(inputId = "lambda_vis",
label = "Parameter for visual data",
min = 0,
max = 100,
value = 20,
width = '100%'),
lambda_aud <- sliderInput(inputId = "lambda_aud",
label = "Parameter for auditory data",
min = 0,
max = 100,
value = 20,
width = '100%'),
uiOutput("lambda_cross")
)
)
),
tabPanel("Data table",
fluidRow(
column(7,
h3("Data table"),
br(),
textOutput('tableexp'),
hr(),
tableOutput('table')),
column(4, offset=1,
h3("CRE Estimates"),
br(),
textOutput('credescr'),
hr(),
textOutput("defold"),
hr(),
withMathJax(uiOutput('oldformula')),
hr(),
splitLayout(cellWidths = c("30", "180", "20"),
h5("="),
withMathJax(uiOutput("oldcre")),
h5("%")
),
br(),
textOutput("defnew"),
hr(),
withMathJax(uiOutput('newformula')),
hr(),
splitLayout(cellWidths = c("30", "180", "20"),
h5("="),
withMathJax(uiOutput("newcre")),
h5("%"))
),
tags$head(tags$style("#defold{font-size: 13px}")),
tags$head(tags$style("#oldformula{font-size: 12px}")),
tags$head(tags$style("#oldcre{font-size: 20px; color:#993366}")),
tags$head(tags$style("#defnew{font-size: 13px}")),
tags$head(tags$style("#newformula{font-size: 12px}")),
tags$head(tags$style("#newcre{font-size: 20px; color:#993366}"))
)
),
tabPanel("Method comparison",
fluidRow(
column(7,
h3("CRE Estimates Comparison"),
hr(),
textOutput('compexp'),
hr(),
plotOutput('comparison', width = "100%", height = "400px")
),
column(4.5, offset=0.5,
h3("CRE Estimates"),
hr(),
br(),
textOutput('defold2'),
br(),
hr(),
withMathJax(uiOutput('oldformula2')),
hr(),
splitLayout(cellWidths = c("30", "180", "20"),
h5("="),
withMathJax(uiOutput("oldcre2")),
h5("%")
),
br(),
textOutput("defnew2"),
hr(),
withMathJax(uiOutput('newformula2')),
hr(),
splitLayout(cellWidths = c("30", "180", "20"),
h5("="),
withMathJax(uiOutput("newcre2")),
h5("%")),
tags$head(tags$style("#defold2{font-size: 13px}")),
tags$head(tags$style("#oldformula2{font-size: 12px}")),
tags$head(tags$style("#oldcre2{font-size: 20px; color:#993366}")),
tags$head(tags$style("#defnew2{font-size: 13px}")),
tags$head(tags$style("#newformula2{font-size: 12px}")),
tags$head(tags$style("#newcre2{font-size: 20px; color:#993366}"))
)
)
),
tabPanel("Use Empirical Data",
fluidRow(
column(5,
h3("Upload your own Data"),
hr(),
textOutput('upload'),
hr(),
fileInput("file1", "Choose CSV File",
accept = c(
"text/csv",
"text/comma-separated-values,text/plain",
".csv")),
tableOutput("table.output")
),
column(6, offset=0.5,
h3("Compare the CRE Estimates"),
hr(),
plotOutput("comparisonemp"),
hr(),
br(),
h4("CRE Estimates"),
br(),
hr(),
textOutput("defold3"),
hr(),
withMathJax(uiOutput('oldformula3')),
hr(),
splitLayout(cellWidths = c("30", "180", "20"),
h5("="),
withMathJax(uiOutput("oldcre3")),
h5("%")
),
br(),
textOutput("defnew3"),
hr(),
withMathJax(uiOutput('newformula3')),
hr(),
splitLayout(cellWidths = c("30", "180", "20"),
h5("="),
withMathJax(uiOutput("newcre3")),
h5("%"))
),
tags$head(tags$style("#defold3{font-size: 13px}")),
tags$head(tags$style("#oldformula3{font-size: 12px}")),
tags$head(tags$style("#oldcre3{font-size: 20px; color:#993366}")),
tags$head(tags$style("#defnew3{font-size: 13px}")),
tags$head(tags$style("#newformula3{font-size: 12px}")),
tags$head(tags$style("#newcre3{font-size: 20px; color:#993366}")
)
)
)
)
)
server <- function(input, output) {
# set lambda_cross value to sum----------------------------------------
output$lambda_cross <- renderUI({
sliderInput(inputId = "lambda_cross",
label = "Parameter for crossmodal data",
min = 0,
max = as.numeric(sum(input$lambda_vis, input$lambda_aud)*2),
value = as.numeric(sum(input$lambda_vis, input$lambda_aud)),
width = '100%')
})
# generate poisson data------------------------------------------------
visual <- reactive(rpois(input$n, input$lambda_vis))
auditory <- reactive(rpois(input$n, input$lambda_aud))
cross <- reactive(rpois(input$n, input$lambda_cross))
trial <- reactive(c(1:input$n))
dat <- reactive(as.data.frame(cbind(Trial = trial(), Visual = visual(), Auditory = auditory(),
Crossmodal = cross())))
# sort the data and take the maximum of each row-----------------------
visual_s <- reactiveValues()
visual_s <- reactive(sort(visual(), decreasing = T))
auditory_s <- reactiveValues()
auditory_s <- reactive(sort(auditory(), decreasing = F))
maximum <- reactiveValues()
maximum <- reactive(pmax(auditory_s(), visual_s()))
dat <- reactive(as.data.frame(cbind(Trial = trial(), Visual = visual(), Auditory = auditory(),
Crossmodal = cross(), Sorted_Visual = visual_s(),
Sorted_Auditory = auditory_s(), Max = maximum())))
# plots for the data-------------------------------------------------
# browser()
output$plotv =renderPlot(
ggbarplot(dat(), x = "Trial", y = "Visual",
color = "lightblue", fill = "lightblue",
width = 0.7, xlab = "Trial", ylab = "Number of spikes",
label = TRUE, lab.col = "black",
lab.size = 4, lab.pos = "in",lab.vjust = 0.5, lab.hjust = 1,
orientation="horizontal", xticks.by = 5))
output$plota =renderPlot(
ggbarplot(dat(), x = "Trial", y = "Auditory",
color = "#99bbff", fill = "#99bbff",
width = 0.7, xlab = "Trial", ylab = "Number of spikes",
label = TRUE, lab.col = "black",
lab.size = 4, lab.pos = "in",lab.vjust = 0.5, lab.hjust = 1,
orientation="horizontal", xticks.by = 5))
output$plotc =renderPlot(
ggbarplot(dat(), x = "Trial", y = "Crossmodal",
color = "#ccb3ff", fill = "#ccb3ff",
width = 0.7, xlab = "Trial", ylab = "Number of spikes",
label = TRUE, lab.col = "black",
lab.size = 4, lab.pos = "in",lab.vjust = 0.5, lab.hjust = 1,
orientation="horizontal", xticks.by = 5))
# table with generated data----------------------------------------------
# create a new row for the data with column means
mean_vis <- reactive(mean(visual()))
mean_aud <- reactive(mean(auditory()))
mean_cross <- reactive(mean(cross()))
mean_viss <- reactive(mean(visual_s()))
mean_auds <- reactive(mean(auditory_s()))
mean_max <- reactive(mean(maximum()))
newline <- reactive({data.frame(Trial="<b>Means</b>", Visual=mean_vis(), Auditory=mean_aud(),
Crossmodal=mean_cross(), Sorted_Visual = mean_viss(),
Sorted_Auditory = mean_auds(), Max=mean_max())})
# add the row with the means to the rest of the data
dat_mean <- reactive(rbind(dat(), newline()))
# generate table
output$table <- renderTable({dat_mean()}, spacing = "m", align = "c",
striped = TRUE, bordered = TRUE, digits = 2,
sanitize.text.function=function(x){x})
# instructions------------------------------------------------------------------------
output$credescr <- renderText({
"The Crossmodal Response Enhancement (CRE) index is
a descriptive measure of the magnitude of multisensory integration
which is defined in terms of proportion of the strongest unisensory response.
While the old measure considers only the higher mean of the two unimodal conditions
(either the visual or the auditory), the new measure uses the mean of the maximum values for each pair
of sorted unimodal data. This method takes data from both modalities into account and yields
a higher mean of unimodal activity."
})
output$parexpl <- renderText({
"You can simulate spike activity using the Poisson method to create
a Poisson distribution. The Poisson distribution describes the probability of
events happening in a fixed period of time, assuming you know how often the event has occured
(in other words, the expected number of event occurences).
The expected number of event occurences is labelled as lambda.
To simulate data with the Poisson method you need to specify the number
of values to be simulated (= number of trials) and lambda. You can set your
desired number of trials. Using the sliders on the right,
you can change the lambda for each unimodal or crossmodal condition. Note that the
default lambda value for the crossmodal condition
is the sum of the lambda of both unimodal conditions."
})
output$tableexp <- renderText({
"This table depicts the simulated number of spikes (within a response window) from the
Poisson distribution based on your choice of parameters. The spike activity is presented
in the columns \"Visual\", \"Auditory\"
and \"Crossmodal\". The unimodal responses in the columns \"Sorted_Visual\" and \"Sorted_Auditory\"
have been sorted in an antithetic order, increasing in the first modality
and decreasing in the other. The \"Maximum\" column displays the higher value in each pair
of sorted unimodal responses. The last row depicts the means for each column."
})
output$compexp <- renderText({
"This table depicts the average numbers of spikes in the unimodal (visual and auditory) conditions,
the mean of the maxima from each pair of sorted unimodal responses,
as well as the average number of spikes in the crossmodal condition.
It can be seen, that the proposed new method always produces a higher value for unimodal
spike activity."
})
# Formulas and indices ----------------------------------------------------------------
output$defold <- renderText({
"Traditional formula for calculating the crossmodal enhancement index (CRE):"
})
output$oldformula <- renderUI({
withMathJax(
"$$CRE = \\frac{CM - SM_{max}}{SM_{max}}\\times100$$"
)
})
output$oldcre <- renderUI({
withMathJax(
(mean_cross() - max(mean_aud(), mean_vis())) / max(mean_aud(), mean_vis()) *100)
})
output$defnew <- renderText({
"Proposed new formula for calculating the crossmodal enhancement index (CRE):"
})
output$newformula <- renderUI({
withMathJax(
"$$CRE_{SP} = \\frac{EN_{VA} - max\\{EN_{V},EN_{A}\\}}{max\\{EN_{V},EN_{A}\\}}\\times100$$"
)
})
output$newcre <- renderUI({
withMathJax(
(mean_cross() - mean_max()) / mean_max() *100
)
})
# plot for comparison of the means----------------------------------------------------
datacomparison <- reactive(data.frame(Conditions=c("Visual", "Auditory",
"Maxima", "Crossmodal"),
Means=c(mean_vis(), mean_aud(), mean_max(), mean_cross())))
output$comparison <- renderPlot(
ggbarplot(datacomparison(), x = "Conditions", y = "Means",
label = TRUE, label.pos = "out",
order = c("Visual", "Auditory", "Maxima", "Crossmodal"),
fill = "Conditions", color = "Conditions",
palette = c("lightblue", "#99bbff", "#ccb3ff", '#ff99cc'),
legend='none', xlab = FALSE, lab.nb.digits = 2)
)
# formulas and indices for the last page---------------------------------------------
output$defold2 <- renderText({
"Traditional formula for calculating the crossmodal enhancement index (CRE):"
})
output$oldformula2 <- renderUI({
withMathJax(
"$$CRE = \\frac{CM - SM_{max}}{SM_{max}}\\times100$$"
)
})
output$oldcre2 <- renderUI({
withMathJax(
(mean_cross() - max(mean_aud(), mean_vis())) / max(mean_aud(), mean_vis()) *100)
})
output$defnew2 <- renderText({
"Proposed new formula for calculating the crossmodal enhancement index (CRE):"
})
output$newformula2 <- renderUI({
withMathJax(
"$$CRE_{SP} = \\frac{EN_{VA} - max\\{EN_{V},EN_{A}\\}}{max\\{EN_{V},EN_{A}\\}}\\times100$$"
)
})
output$newcre2 <- renderUI({
withMathJax(
(mean_cross() - mean_max()) / mean_max() *100
)
})
# upload data page-----------------------------------------------------------------
# instructions for the upload
output$upload <- renderText(
"You can now upload you own data to calculate the CRE index using both methods.
The .csv file should include four columns and include the following headings
(without quotation marks) in the first row: \"Trial\", \"Visual\", \"Auditory\",
and \"Crossmodal\"."
)
# upload csv.file
mydata <- reactive({
inFile <- input$file1
if (is.null(inFile))
return(NULL)
tbl <- read.csv(inFile$datapath, header=TRUE)
return(tbl)
})
output$table.output <- renderTable({
mydata()}, spacing = "m", align = "c",
striped = TRUE, bordered = TRUE, digits = 2)
# calculate the means and sort the columns----------------------------------------
crossemp <- reactive(mydata()$Crossmodal)
visualemp <- reactive(mydata()$Visual)
auditoryemp <- reactive(mydata()$Auditory)
visualemp_s <- reactiveValues()
visualemp_s <- reactive(sort(mydata()$Visual, decreasing = T))
auditoryemp_s <- reactiveValues()
auditoryemp_s <- reactive(sort(mydata()$Auditory, decreasing = F))
maximumemp <- reactiveValues()
maximumemp <- reactive(pmax(auditoryemp_s(), visualemp_s()))
mean_crossemp <- reactive(mean(crossemp()))
mean_visemp <- reactive(mean(visualemp()))
mean_audemp <- reactive(mean(auditoryemp()))
mean_maxemp <- reactive(mean(maximumemp()))
# display barchart with means-----------------------------------------------------
dataempirical <- reactive(data.frame(Conditions=c("Visual", "Auditory",
"Maxima", "Crossmodal"),
Means=c(mean_visemp(), mean_audemp(),
mean_maxemp(), mean_crossemp())))
output$comparisonemp <- renderPlot(
ggbarplot(dataempirical(), x = "Conditions", y = "Means",
label = TRUE, label.pos = "out",
order = c("Visual", "Auditory", "Maxima", "Crossmodal"),
fill = "Conditions", color = "Conditions",
palette = c("lightblue", "#99bbff", "#ccb3ff", '#ff99cc'),
legend='none', xlab = FALSE, lab.nb.digits = 2))
# formulas and indices for the last page---------------------------------------------
output$defold3 <- renderText({
"Traditional formula for calculating the crossmodal enhancement index (CRE):"
})
output$oldformula3 <- renderUI({
withMathJax(
"$$CRE = \\frac{CM - SM_{max}}{SM_{max}}\\times100$$"
)
})
output$oldcre3 <- renderUI({
withMathJax(
(mean_crossemp() - max(mean_audemp(), mean_visemp())) / max(mean_audemp(), mean_visemp()) *100)
})
output$defnew3 <- renderText({
"Proposed new formula for calculating the crossmodal enhancement index (CRE):"
})
output$newformula3 <- renderUI({
withMathJax(
"$$CRE_{SP} = \\frac{EN_{VA} - max\\{EN_{V},EN_{A}\\}}{max\\{EN_{V},EN_{A}\\}}\\times100$$"
)
})
output$newcre3 <- renderUI({
withMathJax(
(mean_crossemp() - mean_maxemp()) / mean_maxemp() *100
)
})
}
shinyApp(ui, server)