search

EducationShinyAppTeam / Style_Guide

Style Guide
https://educationshinyappteam.github.io/Style_Guide/
Other
1 stars 1 forks source link

In-line input fields #27

Open neilhatfield opened 4 years ago

neilhatfield commented 4 years ago

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

ethanwright3 commented 4 years ago

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 commented 4 years ago

check

cross

check.png and cross.png