human-shiny: Shiny bindings for human

In shinybody: An Interactive Anatomography Widget for 'shiny'

Shiny bindings for human

Description

Output and render functions for using human within Shiny applications and interactive Rmd documents.

Usage

humanOutput(outputId, width = "100%", height = "400px")

renderHuman(expr, env = parent.frame(), quoted = FALSE)

Arguments

outputId	output variable to read from
width, height	Must be a valid CSS unit (like '100%', '400px', 'auto') or a number, which will be coerced to a string and have 'px' appended.
expr	An expression that generates a human
env	The environment in which to evaluate expr.
quoted	Is expr a quoted expression (with quote())? This is useful if you want to save an expression in a variable.

Value

A shiny.tag.list object (in the case of humanOutput) or a shiny.render.function object (in the case of renderHuman).

Examples

if (interactive()) {
  library(shiny)

  male_organs <- shinybody::shinybody_organs$organ[shinybody::shinybody_organs$male]
  female_organs <- shinybody::shinybody_organs$organ[shinybody::shinybody_organs$female]

  ui <- function() {
    fluidPage(
      selectInput(
        inputId = "gender",
        label = "Select Gender",
        choices = c("male", "female"),
        multiple = FALSE,
        selected = "male"
      ),
      selectInput(
        inputId = "body_parts",
        label = "Select Body Parts to Show",
        choices = male_organs,
        multiple = TRUE,
        selected = male_organs[1:5]
      ),
      humanOutput(outputId = "human_widget"),
      verbatimTextOutput(outputId = "clicked_body_part_msg"),
      verbatimTextOutput(outputId = "selected_body_parts_msg")
    )
  }

  server <- function(input, output, session) {
    observe({
      g <- input$gender
      if (g == "male") {
        organ_choices <- male_organs
      } else {
        organ_choices <- female_organs
      }

      updateSelectInput(
        session = session,
        inputId = "body_parts",
        choices = organ_choices,
        selected = organ_choices[1:5]
      )
    })

    output$human_widget <- renderHuman({
      selected_organ_df <- subset(
        shinybody::shinybody_organs,
        organ %in% input$body_parts
      )
      selected_organ_df$show <- TRUE
      human(
        organ_df = selected_organ_df,
        select_color = "red"
      )
    })
    output$clicked_body_part_msg <- renderPrint({
      paste("You Clicked:", input$clicked_body_part)
    })
    output$selected_body_parts_msg <- renderPrint({
      paste("Selected:", paste(input$selected_body_parts, collapse = ", "))
    })
  }

  shinyApp(ui = ui, server = server)
}

shinybody documentation built on April 4, 2025, 3:28 a.m.