Nothing
#### The file contains the server part of the UI (interactive UI)
## constructs tab panel for the input controls
tabPanel.input <- function(names.dd){
if(input$analysis == "Consumer data")
return(tabPanel("Input arguments",
selectInput("Response", "Select response", names.dd,
selected = "Liking"),
selectInput("Consumers", "Select consumer", names.dd,
selected = "Consumer"),
selectizeInput("Products", "Select products", names.dd,
options = list(dropdownParent = 'body'),
multiple = TRUE, selected = c("Product",
"Information")),
selectizeInput("Consumerchar",
"Select consumer characteristics",
names.dd,
options = list(dropdownParent = 'body'),
multiple = TRUE, selected = c("Gender",
"Age")),
selectizeInput("Consumerfact",
"Consumer characteristics treated as factors",
names.dd,
options = list(dropdownParent = 'body'),
multiple = TRUE, selected = "Gender")
))
else {
if(input$uploaddata == 2)
return(tabPanel("Input arguments",
selectizeInput("Attributes", "Select attributes",
names.dd,
options = list(dropdownParent = 'body'),
multiple = TRUE, selected =
names.dd[5:(length(names.dd)-1)]),
selectInput("Assessors", "Select assessor",
names.dd, selected =
ifelse(input$uploaddata == 2, "Assessor",
"")),
selectInput("Replications", "Select replications",
names.dd, selected =
ifelse(input$uploaddata == 2, "Repeat",
"")),
selectizeInput("Products", "Select products", names.dd,
options = list(dropdownParent = 'body'),
multiple = TRUE, selected = c("product"))
))
else
return(tabPanel("Input arguments",
selectizeInput("Attributes", "Select attributes",
names.dd,
options = list(dropdownParent = 'body'),
multiple = TRUE),
selectInput("Assessors", "Select assessor",
names.dd),
selectInput("Replications", "Select replications",
names.dd),
selectizeInput("Products", "Select products", names.dd,
options = list(dropdownParent = 'body'),
multiple = TRUE))
)
}
}
## constructs tab panel for the modelling controls
tabPanel.model <- function(){
if(input$analysis == "Consumer data")
return(tabPanel("Modelling controls",
selectInput('struct', 'Select structure',
c("1" = 1, "2" = 2, "3" = 3))
))
else
return(tabPanel("Modelling controls",
selectInput('struct',
'Select product structure',
c("1" = 1, "2" = 2, "3" = 3)),
bsPopover("struct", paste0("<p><b>1</b>: main effects</p>",
"<p><b>2</b>: main effects and ",
"two way interactions</p>",
"<p><b>3</b>: main effects and ",
"all possible interactions</p>"),
placement = "right", trigger = "hover"),
selectInput('errstruct',
'Select error structure',
c("ONLY-ASS" = "ONLY-ASS",
"ASS-REP" = "ASS-REP")),
bsPopover("errstruct", paste0("<p><b>ONLY-ASS</b>: assessor " ,
"effect and all possible ",
" interactions between ",
"assessor and product ",
"effects</p>",
"<p> <b>ASS-REP</b>: assessor ",
"and replicate effect and ",
"interaction between them ",
"and interaction between ",
"them and product effects</p>"),
placement = "right", trigger = "hover"),
selectInput('MAM', 'Correct for scaling', c("Yes" = TRUE,
"No" = FALSE),
selected = FALSE),
selectInput('multMAM', 'Mult-way scaling', c("No" = FALSE,
"Yes" = TRUE)),
bsPopover("multMAM", paste0("<p><b>No</b>: one scaling effect" ,
"</p>",
"<p> <b>Yes</b>: multiple scaling",
" effects ",
"one for each product effect",
"</p>"),
placement = "right", trigger = "hover")
))
}
## constructs tab panel for the analysis controls
tabPanel.an <- function(){
if(input$analysis == "Consumer data")
return(tabPanel("Analysis controls",
selectInput('alpharand',
'Type 1 error for testing random effects',
c("0.1" = 0.1, "0.2" = 0.2, "0.05" = 0.05)),
selectInput('alphafixed',
'Type 1 error for testing fixed effects',
c("0.05" = 0.05, "0.01" = 0.01,
"0.001" = 0.001)))
)
else
return(tabPanel("Analysis controls",
selectInput('calc_post_hoc', 'Calculate post-hoc',
c("Yes" = TRUE, "No" = FALSE)),
selectInput('simplerr', 'Simplification of error structure',
c("Yes" = TRUE, "No" = FALSE)),
textInput("keep", label = "Effects to keep in a model",
value = "Enter effects separated by space..."),
bsPopover("keep", paste0("<p>Assessor and interaction between Assessor and highest order product effects are always kept in the model</p>"),
placement = "right", trigger = "hover"),
selectInput('alpharand',
'Type 1 error for testing random effects',
c("0.1" = 0.1, "0.2" = 0.2, "0.05" = 0.05)),
selectInput('alphafixed',
'Type 1 error for testing fixed effects',
c("0.05" = 0.05, "0.01" = 0.01,
"0.001" = 0.001))
))
}
output$antypeUI <- renderUI({
#if(input$uploaddata == 1 || input$uploaddata == 2)
# antype <- "Sensory data"
#else if(input$uploaddata == 3)
# antype <- "Consumer data"
return(wellPanel(
h4("Choose type of analysis"),
radioButtons("analysis", "Analysis of",
choices = c("Sensory data", "Consumer data"),
inline = TRUE)
))
})
output$AttrUI <- renderUI({
if(is.null(uploadData()))
{names.dd <- NULL}
else{
dd <- uploadData()
names.dd <- colnames(dd)
}
tabsetPanel(
tabPanel.input(names.dd),
tabPanel.model(),
tabPanel.an()
)
})
tabsCons <- function(){
return(
list(
tabPanel("Data",
h4("Choose data"),
selectInput('uploaddata', '',
c("Read CSV file from local drive" = 1,
"TVbo data" = 2, "Ham data" = 3)),
uiOutput("UploadUI")
),
tabPanel("Step output",
sidebarLayout(
sidebarPanel(
uiOutput("AttrStepUI")),
mainPanel(
htmlOutput("stepRand"),
br(),
htmlOutput("stepFixed")
)
)),
tabPanel("Post-hoc",
sidebarLayout(
sidebarPanel(
uiOutput("AttrPosthocUI"),
uiOutput("EffsPosthocUI")),
mainPanel(
plotOutput("posthocPlot"),
htmlOutput("posthocTable")
)
))
)
)
}
tabsSens <- function(){
return(
list(
tabPanel("Data",
h4("Choose data"),
selectInput('uploaddata', '',
c("Read CSV file from local drive" = 1,
"TVbo data" = 2, "Ham data" = 3)),
uiOutput("UploadUI")
),
tabPanel("Plot output",
helpText("Note: This output is only dedicated for analysis of sensory data"),
conditionalPanel(
condition = "input.analysis == 'Sensory data'",
sidebarLayout(
sidebarPanel(
selectInput('typeEffs', 'Plot effects',
c("random" = 1, "fixed" = 2, "scaling" = 3)),
selectInput('typePlot', 'Plot type',
c("F" = FALSE, "d-prime" = TRUE)),
checkboxInput('stackedPlot', 'stacked', value = TRUE),
selectInput('representPlot', 'Layout',
c("single" = FALSE, "multiple" = TRUE)),
numericInput('scalePlot', label = "Scale plot", value = 1),
downloadButton('downloadPlot', label = "Download Plot")
),
mainPanel(plotOutput("plotsSensMixed"))
), value = 1)),
tabPanel("Table output",
helpText("Note: This output is only dedicated for analysis of sensory data"),
sidebarLayout(
sidebarPanel(
selectInput('typeEffsTable', 'Type of effects',
c("random" = 1, "fixed" = 2, "scaling" = 3,
"all" = 4)),
selectInput("typetable2", "Type", c("html", "latex")),
downloadButton('downloadTable', label = "Download Table")
),
mainPanel(
htmlOutput("tablesSensMixed")
)
),
value = 2),
tabPanel("Step output",
sidebarLayout(
sidebarPanel(
uiOutput("AttrStepUI")),
mainPanel(
htmlOutput("stepRand"),
br(),
htmlOutput("stepFixed")
)
),
value = 3),
tabPanel("Post-hoc",
sidebarLayout(
sidebarPanel(
uiOutput("AttrPosthocUI"),
uiOutput("EffsPosthocUI")),
mainPanel(
plotOutput("posthocPlot"),
htmlOutput("posthocTable")
)
),
value = 4),
tabPanel("MAM analysis",
# Sidebar with a slider input
sidebarPanel(
uiOutput("AttrMAManalysis"),
downloadButton('downloadMAM', label = "Download Table")
),
# Show a plot of the generated distribution
mainPanel(
helpText("Note: Ouput only when the Correct for scaling = TRUE"),
br(),
htmlOutput("MAMtable"),
br(),
htmlOutput("MAMindiv"),
br(),
htmlOutput("MAMperf"),
br(),
plotOutput("MAMplotposthoc"),
bsCollapsePanel("Table output",
htmlOutput("MAMposthoc"), id="colll1",
value="testlll1"),
br(),
htmlOutput("MAMdiffmean")
),
value = 5)
))
}
returnOutputs <- function(){
if(is.null(input$analysis)){
return(tabsSens())
}
if(input$analysis == "Sensory data")
return(tabsSens())
else
return(tabsCons())
}
output$theTabset <- renderUI({
theOutputs <- returnOutputs()
do.call(tabsetPanel, theOutputs)
})
output$AttrStepUI <- renderUI({
if(is.null(Data())) {return()}
if(input$analysis == "Consumer data") {
list(
selectInput("typetable", "Type", c("html", "latex")),
downloadButton('downloadStep', label = "Download Table")
)
}
else{
list(
selectInput("AttrStep", "Select attribute", names(Data()$step_res)),
selectInput("typetable", "Type", c("html", "latex")),
downloadButton('downloadStep', label = "Download Table"))
}
})
output$AttrPosthocUI <- renderUI({
if(is.null(Data())) {return()}
if(input$analysis == "Consumer data") {
selectInput("whichPlot", "Type of Plot",
c("LSMEANS" = "LSMEANS",
"DIFF of LSMEANS" = "DIFF of LSMEANS"))
}
else{
list(
selectInput("AttrPosthoc", "Select attribute", names(Data()$step_res)),
selectInput("whichPlot", "Type of Plot",
c("LSMEANS" = "LSMEANS",
"DIFF of LSMEANS" = "DIFF of LSMEANS")))
}
})
output$AttrMAManalysis <- renderUI({
if(is.null(Data())) {return()}
if(class(Data()) == "conjoint") { return() }
list(
selectInput("AttrMAManalysis", "Select attribute", names(Data()$step_res))
)
})
output$EffsPosthocUI <- renderUI({
if(is.null(Data())) {return()}
if(input$analysis == "Consumer data"){
an.table <- Data()$anova.table
}
else{
if(is.null(input$AttrPosthoc) || length(input$AttrPosthoc)>1)
{return()}
an.table <- Data()$step_res[[input$AttrPosthoc]]$anova.table
}
if("elim.num" %in% colnames(an.table)){
effs <- rownames(an.table[which(an.table$elim.num == "kept"), ,
drop = FALSE])
}
else
effs <- rownames(an.table)
list(
selectInput("effsPlot", "Effects", effs),
downloadButton('downloadPosthocTable', label = "Download Table"),
downloadButton('downloadPosthocPlot', label = "Download Plot")
)
})
output$UploadUI <- renderUI({
if(input$uploaddata == 1){
verticalLayout(
#tags$hr(),
fileInput('file1',
'Choose CSV File from local drive, adjusting parameters if necessary',
accept=c('text/csv', 'text/comma-separated-values,text/plain')),
checkboxInput('header', 'Header', TRUE),
radioButtons('sep', 'Separator',
c(Semicolon=';',
Comma=',',
Tab='\t'),
'Semicolon'),
radioButtons('quote', 'Quote',
c(None='',
'Double Quote'='"',
'Single Quote'="'"),
'Double Quote'),
radioButtons('decimal', 'Decimal',
c("Period" = ".", "Comma" = ",")),
tags$head(tags$style(type="text/css",
"label.radio { display: inline-block; margin:0 10 0 0; }",
".radio input[type=\"radio\"] { float: none; }")),
mainPanel(
dataTableOutput('contents')
)
)
}
else{
verticalLayout(
mainPanel(
dataTableOutput('contents')
)
)
}
})
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.