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:

``` r

install.packages("devtools")

devtools::install_github("robert-norberg/shinybody") ```

You can install from CRAN with:

r install.packages("shinybody")

Example

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

``` r library(shinybody)

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

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:

``` r library(shiny) library(shinybody)

maleorgans <- shinybodyorgans$organ[shinybodyorgans$male] femaleorgans <- shinybodyorgans$organ[shinybodyorgans$female]

ui <- function() { fluidPage( selectInput( inputId = "gender", label = "Select Gender", choices = c("male", "female"), multiple = FALSE, selected = "male" ), selectInput( inputId = "bodyparts", label = "Select Body Parts to Show", choices = maleorgans, multiple = TRUE, selected = maleorgans[1:5] ), humanOutput(outputId = "humanwidget"), verbatimTextOutput(outputId = "clickedbodypartmsg"), verbatimTextOutput(outputId = "selectedbodypartsmsg") ) }

server <- function(input, output, session) { observe({ g <- input$gender if (g == "male") { organchoices <- maleorgans } else { organchoices <- femaleorgans } updateSelectInput( session = session, inputId = "bodyparts", choices = organchoices, selected = organ_choices[1:5] ) })

output$humanwidget <- renderHuman({ selectedorgandf <- subset(shinybody::shinybodyorgans, organ %in% input$bodyparts) selectedorgandf$show <- TRUE human( gender = input$gender, organdf = selectedorgandf, selectcolor = "red" ) }) output$clickedbodypartmsg <- renderPrint({ paste("You Clicked:", input$clickedbodypart) }) output$selectedbodypartsmsg <- renderPrint({ paste("Selected:", paste(input$selectedbody_parts, collapse = ", ")) }) }

shinyApp(ui = ui, server = server) ```

shinybody is crosstalk compatible. Here is an example of a simple crosstalk widget using shinybody and DT.

``` r library(shinybody) library(DT)

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

myorgandfshareddata <- crosstalk::SharedData$new(myorgandf)

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

tbl <- DT::datatable( data = myorgandfshareddata, 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", organdf = myorgandfshared_data), device = "sm" ) ```