diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..5b6a065 --- /dev/null +++ b/.gitignore @@ -0,0 +1,4 @@ +.Rproj.user +.Rhistory +.RData +.Ruserdata diff --git a/R/centileFunctions.R b/R/centileFunctions.R new file mode 100644 index 0000000..a5c59da --- /dev/null +++ b/R/centileFunctions.R @@ -0,0 +1,17 @@ +zscoreFromLms <- function(y, lms) { + req(y, lms) + + if (abs(lms$l) < 0.00001) { + return(log(y / lms$m) / lms$s) + } else { + return(((y / lms$m) ^ lms$l - 1) / (lms$l * lms$s)) + } +} + +yFromLms <- function(zscore, lms) { + if (abs(lms$l) < 0.00001) { + return(exp(zscore * lms$s) * lms$m) + } else { + return((zscore * lms$l * lms$s + 1) ^ (1 / lms$l) * lms$m) + } +} diff --git a/R/targetHeightFunctions.R b/R/targetHeightFunctions.R new file mode 100644 index 0000000..8a25875 --- /dev/null +++ b/R/targetHeightFunctions.R @@ -0,0 +1,43 @@ +data(parentValues) + +#' Calculate target height +#' +#' @param sex One of 'male' and 'female'. +#' @param motherHeight Height of the mother in cm. +#' @param fatherHeight Height of the father in cm. +#' @param method The method to be used to calculate the target height. +#' Possible values are 'Tanner', 'Molinari' and 'Hermanussen'. (defaults to 'Tanner') +#' @param reference The reference to be used to calculate SDS values. (defaults to 'Kromeyer-Hauschild') +#' @return The target height in cm. +#' @examples +#' targetHeight('female', 175, 180, 'Tanner') +targetHeight <- function(sex, motherHeight, fatherHeight, method = 'Tanner', reference = 'Kromeyer-Hauschild') { + if (missing(sex)) stop("required argument 'sex' is missing") + if (missing(motherHeight)) stop("required argument 'motherHeight' is missing") + if (missing(fatherHeight)) stop("required argument 'fatherHeight' is missing") + if (missing(method)) stop("required argument 'method' is missing") + if (missing(reference)) stop("required argument 'reference' is missing") + + if (!sex %in% c('male', 'female')) + stop("'sex' must be one of 'male' or 'female'") + if (!method %in% c('Tanner', 'Molinari', 'Hermanussen')) + stop("'method' must be one of 'Tanner', 'Molinari' or 'Hermanussen'") + + relevantValues <- filter(parentValues, reference == !!reference & measurement == 'height') + + if (method == 'Tanner') { + targetHeight = (motherHeight + fatherHeight) / 2 + ifelse(sex == 'male', 6.5, -6.5) + } else if (method == 'Molinari') { + targetHeight = (motherHeight + fatherHeight) / 2 + ifelse(sex == 'male', 10.2, -2.6) + } else { + fatherHeightSds <- zscoreFromLms(fatherHeight, filter(relevantValues, sex == 'male')) + motherHeightSds <- zscoreFromLms(motherHeight, filter(relevantValues, sex == 'female')) + sds <- (fatherHeightSds + motherHeightSds) / 2 * 0.72 + return(list(height = yFromLms(sds, filter(relevantValues, sex == !!sex)), sds = sds)) + } + + return(list( + height = targetHeight, + sds = zscoreFromLms(targetHeight, filter(relevantValues, sex == !!sex)) + )) +} diff --git a/data/parentValues.RData b/data/parentValues.RData new file mode 100644 index 0000000..b65b579 Binary files /dev/null and b/data/parentValues.RData differ diff --git a/hgh-treatment-evaluation.Rproj b/hgh-treatment-evaluation.Rproj new file mode 100644 index 0000000..8e3c2eb --- /dev/null +++ b/hgh-treatment-evaluation.Rproj @@ -0,0 +1,13 @@ +Version: 1.0 + +RestoreWorkspace: Default +SaveWorkspace: Default +AlwaysSaveHistory: Default + +EnableCodeIndexing: Yes +UseSpacesForTab: Yes +NumSpacesForTab: 2 +Encoding: UTF-8 + +RnwWeave: Sweave +LaTeX: pdfLaTeX diff --git a/server.R b/server.R new file mode 100644 index 0000000..ed69246 --- /dev/null +++ b/server.R @@ -0,0 +1,39 @@ +library(dplyr) +library(childsds) + +shinyServer(function(input, output) { + heightCentile <- reactive({ + req(input$sex, input$age, input$height) + sds <- sds(input$height, input$age, input$sex, 'height', kro.ref) + + if (sds == Inf | sds == -Inf) sds <- NA + + sds + }) + + targetHeights <- reactive({ + req(input$sex, input$motherHeight, input$fatherHeight, input$reference) + do.call( + rbind, + list( + Tanner = data.frame(targetHeight(input$sex, input$motherHeight, input$fatherHeight, 'Tanner', input$reference)), + Molinari = data.frame(targetHeight(input$sex, input$motherHeight, input$fatherHeight, 'Molinari', input$reference)), + Hermanussen = data.frame(targetHeight(input$sex, input$motherHeight, input$fatherHeight, 'Hermanussen', input$reference)) + ) + ) + }) + + output$heightCentile <- renderUI({ + tags$b(sprintf('%.2f SDS (p%.1f)', heightCentile(), pnorm(heightCentile()) * 100)) + }) + + output$targetHeightTable <- renderTable(targetHeights(), rownames = TRUE) + + output$hghTreatmentEvaluation <- renderUI({ + req(heightCentile(), targetHeights()) + difference <- heightCentile() - targetHeights()['Hermanussen',]$sds[1] + tagList( + 'Difference to target height SDS (Hermanussen et al.) is: ', sprintf('%.2f', difference) + ) + }) +}) diff --git a/ui.R b/ui.R new file mode 100644 index 0000000..a162342 --- /dev/null +++ b/ui.R @@ -0,0 +1,38 @@ +library(shiny) + +shinyUI(fluidPage( + title = 'CrescNet hGH Treatment Evaluation App', + titlePanel(title = div(img(src = 'logo.svg', height = '50'), span('hGH Treatment Evaluation App', style = 'vertical-align:bottom'))), + 'Please insert the most recent patient data as well as parental height values on the left site. The evaluation will be displayed on the right site.', + br(), + 'SDS values are calculated with the R package ', a('childsds', href = 'https://cran.r-project.org/package=childsds'), '.', + + tags$h3('Disclaimer'), + 'This tool is not approved as a medicinal product for clinical use, and should be used for research purposes only.', + + hr(), + + sidebarLayout( + sidebarPanel( + radioButtons('sex', 'Sex', choices = c('female', 'male'), inline = TRUE), + sliderInput('age', 'Age (years)', min = 0, max = 20, value = 10, step = .25), + numericInput('height', 'Height (cm)', NULL, min = 0, max = 250), + numericInput('motherHeight', 'Mother height (cm)', NULL, min = 0, max = 250), + numericInput('fatherHeight', 'Father height (cm)', NULL, min = 0, max = 250), + selectInput('reference', 'Reference', c('Kromeyer-Hauschild')) + ), + + mainPanel( + wellPanel(tags$h4('Height SDS:', uiOutput('heightCentile', inline = TRUE))), + wellPanel(tags$h4('Target heights:'), tableOutput('targetHeightTable')), + wellPanel(tags$h4('hGH treatment evaluation:'), uiOutput('hghTreatmentEvaluation')) + ) + ), + + tags$footer( + hr(), + tags$small('Source code of this Shiny app is available at: ', + a('GitHub', href = 'https://github.com/CrescNet/hgh-treatment-evaluation') + ), align = 'center' + ) +)) diff --git a/www/logo.svg b/www/logo.svg new file mode 100644 index 0000000..3e817f5 --- /dev/null +++ b/www/logo.svg @@ -0,0 +1,206 @@ + + + CrescNet + + + + + + + + + + + + + + + + + + + + + + image/svg+xml + + CrescNet + + + + + + + + + + + + + + + + + + + + +