library(shiny)
# Define UI
ui <- fluidPage(
tags$head(
tags$link(rel = "stylesheet", type = "text/css", href = "styles.css"),
tags$link(rel = "preconnect", href = "https://fonts.googleapis.com"),
tags$link(rel = "preconnect", href = "https://fonts.gstatic.com", crossorigin = ""),
tags$link(href = "https://fonts.googleapis.com/css2?family=Montserrat:wght@700&display=swap", rel = "stylesheet")
),
h2("Sex Prediction from Radius Measurements", class = "title"),
sidebarLayout(
sidebarPanel(
numericInput("mlr", "Maximum Length of Radius (MLR):", value = 0, min = 0, step = 0.1),
numericInput("chr", "Head Circumference (CHR):", value = 0, min = 0, step = 0.1),
numericInput("ncr", "Neck Circumference (NCR):", value = 0, min = 0, step = 0.1),
numericInput("tdhr", "Transverse Diameter of the Shaft (TDHR):", value = 0, min = 0, step = 0.1),
numericInput("sdhr", "Sagittal Diameter of the Shaft (SDHR):", value = 0, min = 0, step = 0.1),
numericInput("mcddr", "Minimum Circumference in Distal Diaphysis (MCDDR):", value = 0, min = 0, step = 0.1),
numericInput("iewr", "Inferior Epiphysis Width (IEWR):", value = 0, min = 0, step = 0.1)
),
mainPanel(
tabsetPanel(
tabPanel("Model LR1",
p("Model: (0.157 × MLR) + (0.424 × CHR) - 61.899"),
textOutput("prediction1")
),
tabPanel("Model LR2",
p("Model: (0.142 × MLR) + (0.264 × CHR) + (0.467 × MCDDR) − 65.743"),
textOutput("prediction2")
),
tabPanel("Model LR3",
p("Model: (0.133 × MLR) + (0.237 × CHR) + (0.409 × MCDDR) + (0.275 × IEWR) - 68.280"),
textOutput("prediction3")
),
tabPanel("Model LR4",
p("Model: (0.131 × MLR) + (0.301 × CHR) + (0.495 × MCDDR) + (0.254 × IEWR) + (−0.136× NCR) − 68.568"),
textOutput("prediction4")
),
tabPanel("Model LR5",
p("Model: (0.559 × MCDDR) + (0.700 × IEWR) − 42.223"),
textOutput("prediction5")
),
tabPanel("Model LR6",
p("Model: (0.558 × CHR) + (0.456 × SDHR) + (−0.247 × TDHR) − 39.905"),
textOutput("prediction6")
)
),
br(),
br(),
br(),
br(),
img(src = "radius.jpg", alt = "Osteometric dimensions in the radius.", width = "100%"),
br(),
br(),
p("Osteometric dimensions in the radius. 1) maximum length (MLR); 2) inferior epiphysis width (IEWR); 3) minimum circumference in the distal diaphysis (MCDDR); 4) transverse diameter of the shaft (TDHR); 5) sagittal diameter of the shaft (SDHR), perpendicular to 4); 6) minimum circumference in the proximal diaphysis (MCPDR); 7) neck circumference (CNR); and 8) circumference of the head (CHR))."),
br(),
br(),
br(),
br(),
p("Please read this paper for more details: Curate, F.; Mestre, F.; Garcia, S.J. (2021).",
em(" Sex Assessment with the Radius in Portuguese Skeletal Populations (Late 19th – Early to Mid 20th Centuries). Leg. Med. "),
a("(DOI: 10.1016/j.legalmed.2020.101790)",
href = "https://doi.org/10.1016/j.legalmed.2020.101790",
target = "_blank")
),
br(),
br(),
div(class = "app-info", p("App Development: Francisco Curate (fcurate@uc.pt / franciscocurate@gmail.com)")),
br(),
div(class = "app-info", p("Disclaimer: This application is freely provided as an aid for the estimation of skeletal sex. The author has no responsibility for its ultimate use or misuse."))
)
)
)
# Define server logic
server <- function(input, output) {
# Model LR1
output$prediction1 <- renderText({
logit1 <- (0.157 * input$mlr) + (0.424 * input$chr) - 61.899
prob_male1 <- 1 / (1 + exp(-logit1))
prob_female1 <- 1 - prob_male1
sprintf("Probability of being Male: %.2f%%\nProbability of being Female: %.2f%%", prob_male1 * 100, prob_female1 * 100)
})
# Model LR2
output$prediction2 <- renderText({
logit2 <- (0.142 * input$mlr) + (0.264 * input$chr) + (0.467 * input$mcddr) - 65.743
prob_male2 <- 1 / (1 + exp(-logit2))
prob_female2 <- 1 - prob_male2
sprintf("Probability of being Male: %.2f%%\nProbability of being Female: %.2f%%", prob_male2 * 100, prob_female2 * 100)
})
# Model LR3
output$prediction3 <- renderText({
logit3 <- (0.133 * input$mlr) + (0.237 * input$chr) + (0.409 * input$mcddr) + (0.275 * input$iewr) - 68.280
prob_male3 <- 1 / (1 + exp(-logit3))
prob_female3 <- 1 - prob_male3
sprintf("Probability of being Male: %.2f%%\nProbability of being Female: %.2f%%", prob_male3 * 100, prob_female3 * 100)
})
# Model LR4
output$prediction4 <- renderText({
logit4 <- (0.131 * input$mlr) + (0.301 * input$chr) + (0.495 * input$mcddr) + (0.254 * input$iewr) - (0.136 * input$ncr) - 68.658
prob_male4 <- 1 / (1 + exp(-logit4))
prob_female4 <- 1 - prob_male4
sprintf("Probability of being Male: %.2f%%\nProbability of being Female: %.2f%%", prob_male4 * 100, prob_female4 * 100)
})
# Model LR5
output$prediction5 <- renderText({
logit5 <- (0.559 * input$mcddr) + (0.700 * input$iewr) - 42.223
prob_male5 <- 1 / (1 + exp(-logit5))
prob_female5 <- 1 - prob_male5
sprintf("Probability of being Male: %.2f%%\nProbability of being Female: %.2f%%", prob_male5 * 100, prob_female5 * 100)
})
# Model LR6
output$prediction6 <- renderText({
logit6 <- (0.558 * input$chr) + (0.456 * input$sdhr) - (0.247 * input$tdhr) - 39.905
prob_male6 <- 1 / (1 + exp(-logit6))
prob_female6 <- 1 - prob_male6
sprintf("Probability of being Male: %.2f%%\nProbability of being Female: %.2f%%", prob_male6 * 100, prob_female6 * 100)
})
}
# Run the application
shinyApp(ui = ui, server = server)
Comentários
Enviar um comentário