In-line input fields

[neilhatfield]

Add guidance for doing in-line input fields (such as text input, drop-down).

[ethanwright3]

#THE FOLLOWING IS THE FULL CODE TO AN APP THAT DEMONSTRATES FILL IN THE BLANK
library(shiny)
library(shinydashboard)
library(shinyBS)

ui <- list(
tags$head(
tags$link(rel = "stylesheet", type = "text/css",
href = "https://educationshinyappteam.github.io/Style_Guide/theme/boast.css")
#href = "boast.css") ## This is for Neil's testing purposes
),

#Create the app page
dashboardPage(
skin = "blue",
### Create the app header
dashboardHeader(
title = "Fill In Blank Sample",
tags$li(class = "dropdown", actionLink("info", icon("info"))),
tags$li(class = "dropdown",
tags$a(href='https://github.com/EducationShinyAppTeam/BOAST',
icon("github"))),
tags$li(class = "dropdown",
tags$a(href='https://shinyapps.science.psu.edu/',
icon("home")))
),
### Create the sidebar/left navigation menu
dashboardSidebar(
sidebarMenu(
id = "tabs",
menuItem(text = "Overview", tabName = "Overview", icon = icon("dashboard")),
menuItem(text = "Fill In Blank", tabName = "FillInBlank", icon = icon("book")),
menuItem(text = "Reversable", tabName = "reversable", icon = icon("book"))
),
tags$div(
class = "sidebar-logo",
boastUtils::psu_eberly_logo("reversed")
)
),
### Create the content
dashboardBody(
tabItems(
#### Set up the Overview Page
tabItem(
tabName = 'Overview',
withMathJax(),
h1("Base functions for fill in blank and response questions"),
h2("Instructions"),
p("Each tab contains code for a slightly differant approach"),
tags$ol(
tags$li("Standard Fill in blank"),
tags$li("Reversible entries tab (currently still in standard
fill, coming soon to own tab)")
),
##### Go Button--location will depend on your goals
div(
style = "text-align: center",
bsButton(
inputId = "go1",
label = "GO!",
size = "large",
icon = icon(name = "bolt"),
style = "default"
)
),
br(),br(),
h2("Acknowledgements"),
p("This version of the app was developed and coded by Ethan Wright",
br(),
"I would like to extend a special thanks to the Shiny Program
Students. In particular Chenese who was an incredible help with the UI",
br(), br(), br(),
div(class = "updated", "Last Update: 5/29/2020 by EJW")
)
),
#### Set up the Drop Down Page
tabItem(
tabName = "Dropdown",
withMathJax(),
h2("Drop down menus"),
box(
title = strong("Sample 1"),
status = "primary",
collapsible = TRUE,
collapsed = TRUE,
width = '100%',
""
),
box(
title = strong("Sample 2"),
status = "primary",
collapsible = TRUE,
collapsed = FALSE,
width = '100%',
""
)
),
tabItem(
tabName = 'FillInBlank',
withMathJax(),
h2("Fill in blank standard (answers can't be reversed)"),

      #HERE IS THE UI FOR PUTTING IN THE TEXT AND THE BLANKS
        #IT SIMPLY CONSISTS OF 3 PARTS: TEXT OUTPUT, BLANK INPUT SPACES, AND HTML OUTPUT FOR THE IMAGE
        #It's not pretty or fast TO TYPE but the use of display:inline-block is the only known
        #   way to get the text and the blanks to line up correctly that has been found
        div(style = "display:inline-block", p("As the distance between points  ")), #text
      div(style = "display:inline-block", textInput(inputId = "word1", label = "")), #The blank to be filled
      div(style = "display:inline-block", htmlOutput(outputId = "answer1")), #Image output, check or X
      div(style = "display:inline-block", p(', their reliability ')), #Repeat
      div(style = "display:inline-block", textInput(inputId = "word2", label = "")),
      div(style = "display:inline-block", htmlOutput(outputId = "answer2")),
      actionButton("submit", "submit Answer")
    ),
    tabItem(
      tabName = 'reversable',
      withMathJax(),
      h2("Fill in blank where answers are reversible"),
      #order is 
      div(style="display:inline-block", p("As the distance between points  ")),
      div(style="display:inline-block", textInput(inputId = "word3", label = "")),
      div(style ="display:inline-block", htmlOutput(outputId = "answer3")),
      div(style = "display:inline-block", p(', their reliability ')),
      div(style="display:inline-block", textInput(inputId = "word4", label = "")),
      div(style ="display:inline-block", htmlOutput(outputId = "answer4")),
      actionButton("submitReversable", "submit Answer")
    )
  )
)

)
)

server <- function(input, output, session) {
#Go Button goes to explore tab
observeEvent(input$go1, {
updateTabItems(session = session, inputId = "tabs", selected = "Explore")
})

#Purpose: This checks the users input answer against the list of possible answers
#to see if the answer is correct
#Input: The "answer" which is a list or single string that contains the possible
#correct answers. The "inputAnswer" which is the string the user put into the space.
#Output: If one matches the function returns true. If it does not match any the
#function returns false
#Notes: converts the input answers to lower case in order to ensure
#capitilization mismatch doesn't cause an issue
checkAnswer <- function(answer, inputAnswer){
correct <- FALSE #Start out assuming incorrect.
if(class(answer) == 'list') #if multiple right answers due to synonyms
{
for(accessNested in answer)
{
inputAnswer <- tolower(x = inputAnswer)
if(inputAnswer %in% accessNested)
{
correct <- TRUE
}
}
}
else #If only 1 right answer
{
#convert to lower case
inputAnswer <- tolower(x = inputAnswer)
if(answer == inputAnswer)
{
correct <-TRUE #If nested Answer equals input Answer it is correct
}
}

return(correct)

}

#Purpose: To check two answers where they can be reversed
#input: two "inputAnswers" input by the user and 2 "answer#" that are lists with
#possible correct answers.
#output: whether or not the input answers are correct, TRUE or FALSE
#Info: One value in ansewr1 and one in answer2 must match the users input answers.
#However they can be reversed. For example sometimes statement could be increase
#then decreases but also work in the reverse with decreases first than increases
checkReversibleAnswer <- function(answer1, inputAnswer1, answer2, inputAnswer2){
if(checkAnswer(answer1, inputAnswer1))
{
if(checkAnswer(answer2, inputAnswer2)){
return(TRUE)
}
else
{
return(FALSE)
}
}
else if(checkAnswer(answer2, inputAnswer1))
{
if(checkAnswer(answer1, inputAnswer2)){
return(TRUE)
}
else{
return(FALSE)
}
}
else
{
return(FALSE)
}
}

#This is the index of the possible correct answers. Think of it as the answer
#sheet to check to see if answers are valid Each list inside the main list
correctAnswers <- list(increases = list('increases', 'increase', 'goes up', 'widens'),
decreases = list('decreases', 'goes down'))

#Purpose: Check all the answers after the submit button is pressed
#Input: The click of the submit button
#Output: Check or X next to all blanks
observeEvent(input$submit, {
#correctAnswers[#] passes a list of possible correct answers
#input$word# passes a word the user used on a fill in the blank
grade1 <- checkAnswer(answer = correctAnswers$increases, inputAnswer = input$word1)
grade2 <- checkAnswer(answer = correctAnswers$decreases, inputAnswer = input$word2)

#For each blank a result of T/F will deterimne which symbol is output
if(grade1){
  output$answer1 <- renderUI({
    img(src = "check.png", width = 30)
  })
}
else
{
  output$answer1 <- renderUI({
    img(src = "cross.png", width = 30)
  })
}

if(grade2){
  output$answer2 <- renderUI({
    img(src = "check.png", width = 30)
  })
}
else
{
  output$answer2 <- renderUI({
    img(src = "cross.png", width = 30)
  })
}

})

#Purpose: Check all the answers after the submit button is pressed in reversible tab
#Input: The click of the submit button
#Output: Check or X next to all blanks
observeEvent(input$submitReversable, {
grade3 <- checkReversibleAnswer(answer = correctAnswers$increases,
inputAnswer1 = input$word3,
answer2 = correctAnswers$decreases,
inputAnswer2 = input$word4)
#The render image code for when using checkReversibleAnswer
if(grade3){
output$answer3 <- renderUI({
img(src = "check.png", width = 30)
})
output$answer4 <- renderUI({
img(src = "check.png", width = 30)
})
}
else
{
output$answer3 <- renderUI({
img(src = "cross.png", width = 30)
})
output$answer4 <- renderUI({
img(src = "cross.png", width = 30)
})
}
})
}

shinyApp(ui = ui, server = server)

[ethanwright3]

check.png and cross.png