The hardware and bandwidth for this mirror is donated by dogado GmbH, the Webhosting and Full Service-Cloud Provider. Check out our Wordpress Tutorial.
If you wish to report a bug, or if you are interested in having us mirror your free-software or open-source project, please feel free to contact us at mirror[@]dogado.de.

shinybody

shinybody is an htmlwidget of the human body that allows you to hide/show and assign colors to 79 different body parts. The human widget is an htmlwidget, so it works in Quarto documents, R Markdown documents, or anything other HTML medium. It also functions as an input/output widget in a shiny app.

Installation

You can install the development version of shinybody from GitHub with:

# install.packages("devtools")
devtools::install_github("robert-norberg/shinybody")

You can install from CRAN with:

install.packages("shinybody")

Example

Here is a simple example of using the human widget in an R Markdown document:

library(shinybody)

example_organs <- c("brain", "eye", "heart", "stomach", "bladder")
my_organ_df <- subset(shinybody::shinybody_organs, organ %in% example_organs)
my_organ_df$show <- TRUE
my_organ_df$color <- grDevices::rainbow(nrow(my_organ_df))
my_organ_df$selected[1] <- TRUE
my_organ_df$hovertext <- mapply(
  function(o, clr) htmltools::strong(tools::toTitleCase(o), style = paste("color:", clr)),
  my_organ_df$organ,
  my_organ_df$color,
  SIMPLIFY = FALSE
)
human(gender = "female", organ_df = my_organ_df)

Here is a complete list of the organs that are available:

#>                           Male Female
#> adipose_tissue              ✅     ✅
#> adrenal_gland               ✅     ✅
#> amygdala                    ✅     ✅
#> aorta                       ✅     ✅
#> appendix                    ✅     ✅
#> atrial_appendage            ✅     ✅
#> bladder                     ✅     ✅
#> bone                        ✅     ✅
#> bone_marrow                 ✅     ✅
#> brain                       ✅     ✅
#> breast                      ✅     ✅
#> bronchus                    ✅     ✅
#> caecum                      ✅     ✅
#> cartilage                   ✅     ✅
#> cerebellar_hemisphere       ✅     ✅
#> cerebellum                  ✅     ✅
#> cerebral_cortex             ✅     ✅
#> circulatory_system          ✅     ✅
#> colon                       ✅     ✅
#> coronary_artery             ✅     ✅
#> diaphragm                   ✅     ✅
#> duodenum                    ✅     ✅
#> ectocervix                  ❌     ✅
#> endometrium                 ❌     ✅
#> epididymis                  ✅     ❌
#> esophagus                   ✅     ✅
#> eye                         ✅     ✅
#> fallopian_tube              ❌     ✅
#> frontal_cortex              ✅     ✅
#> gall_bladder                ✅     ✅
#> gastroesophageal_junction   ✅     ✅
#> heart                       ✅     ✅
#> ileum                       ✅     ✅
#> kidney                      ✅     ✅
#> left_atrium                 ✅     ✅
#> left_ventricle              ✅     ✅
#> liver                       ✅     ✅
#> lung                        ✅     ✅
#> lymph_node                  ✅     ✅
#> mitral_valve                ✅     ✅
#> nasal_pharynx               ✅     ✅
#> nasal_septum                ✅     ✅
#> nerve                       ✅     ✅
#> nose                        ✅     ✅
#> oral_cavity                 ✅     ✅
#> ovary                       ❌     ✅
#> pancreas                    ✅     ✅
#> parotid_gland               ✅     ✅
#> penis                       ✅     ❌
#> pituitary_gland             ✅     ✅
#> placenta                    ❌     ✅
#> pleura                      ✅     ✅
#> prefrontal_cortex           ✅     ✅
#> prostate_gland              ✅     ❌
#> pulmonary_valve             ✅     ✅
#> rectum                      ✅     ✅
#> renal_cortex                ✅     ✅
#> salivary_gland              ✅     ✅
#> seminal_vesicle             ✅     ❌
#> skeletal_muscle             ✅     ✅
#> skin                        ✅     ✅
#> small_intestine             ✅     ✅
#> smooth_muscle               ✅     ✅
#> spinal_cord                 ✅     ✅
#> spleen                      ✅     ✅
#> stomach                     ✅     ✅
#> submandibular_gland         ✅     ✅
#> temporal_lobe               ✅     ✅
#> testis                      ✅     ❌
#> throat                      ✅     ✅
#> thyroid_gland               ✅     ✅
#> tongue                      ✅     ✅
#> tonsil                      ✅     ✅
#> trachea                     ✅     ✅
#> tricuspid_valve             ✅     ✅
#> uterine_cervix              ❌     ✅
#> uterus                      ❌     ✅
#> vagina                      ❌     ✅
#> vas_deferens                ✅     ❌

Here is a very simple shiny app using the human widget:

library(shiny)
library(shinybody)

male_organs <- shinybody_organs$organ[shinybody_organs$male]
female_organs <- shinybody_organs$organ[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(
      gender = input$gender,
      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 is crosstalk compatible. Here is an example of a simple crosstalk widget using shinybody and DT.

library(shinybody)
library(DT)

example_organs <- c("brain", "eye", "heart", "stomach", "bladder")
my_organ_df <- subset(shinybody::shinybody_organs, organ %in% example_organs)
my_organ_df$show <- TRUE
my_organ_df$color <- grDevices::rainbow(nrow(my_organ_df))
my_organ_df$selected[1] <- TRUE
my_organ_df$hovertext <- mapply(
  function(o, clr) htmltools::strong(tools::toTitleCase(o), style = paste("color:", clr)),
  my_organ_df$organ,
  my_organ_df$color,
  SIMPLIFY = FALSE
)

my_organ_df_shared_data <- crosstalk::SharedData$new(my_organ_df)

checkboxes <- crosstalk::filter_checkbox(
  id = "filter",
  label = "Organ",
  sharedData = my_organ_df_shared_data,
  group = ~organ
)

tbl <- DT::datatable(
  data = my_organ_df_shared_data,
  options = list(
    pageLength = 10,
    columnDefs = list(
      list(visible = FALSE, targets = c("male", "female", "show", "selected", "hovertext"))
    )
  ),
  rownames = FALSE,
  height = "500px",
  autoHideNavigation = TRUE
)

crosstalk::bscols(
  htmltools::tagList(checkboxes, tbl),
  human(gender = "female", organ_df = my_organ_df_shared_data),
  device = "sm"
)

These binaries (installable software) and packages are in development.
They may not be fully stable and should be used with caution. We make no claims about them.
Health stats visible at Monitor.