SHARE
TWEET

Untitled

a guest Mar 21st, 2019 75 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. # install.packages("profvis")
  2. # install.packages("scales")
  3. # install.packages("reticulate")
  4. # install.packages("shiny")
  5. # install.packages("tidyverse")
  6. # devtools::install_github("rstudio/rsconnect", ref='737cd48')
  7.  
  8. library(foreign)
  9. library(shiny)
  10. library(ggplot2)
  11. library(reticulate)
  12. library(scales)
  13. library(tidyverse)
  14.  
  15. virtualenv_create(envname = "python_environment", python= "python3")
  16. #virtualenv_install("python_environment", packages = c('keras', 'pandas','numpy','scipy','scikit-learn', 'tensorflow'))
  17. reticulate::use_virtualenv("python_environment", required = TRUE)
  18.  
  19. # Define UI for the health predictor tool
  20.  
  21. ui <- fluidPage(
  22.   titlePanel("Health Outcome Predictor Tool"),
  23.  
  24.   # Sidebar layout with a input and output definitions
  25.   sidebarLayout(
  26.    
  27.     # Inputs
  28.     sidebarPanel(
  29.      
  30.       # Select race
  31.      
  32.       h3("Health Outcome Selection", align = "center"),
  33.      
  34.       #have to figure out how to structure the =x to make it so that it will be able to call the correct neural net
  35.       selectInput(inputId = "health_outcome",
  36.                   label = "Select the health outcome of interest:",
  37.                   choices = c("Anxiety",
  38.                               "Overweight"),
  39.                   selected = "Overweight"),
  40.      
  41.       h3("Demographics and ACE Data", align = "center"),
  42.      
  43.       # Select race
  44.       selectInput(inputId = "race",
  45.                   label = "Select your race:",
  46.                   choices = c("White"=1,
  47.                               "Black"=2,
  48.                               "Asian"=3,
  49.                               "Native Hawaiian or other Pacific Islander"=4,
  50.                               "American Indian or Alaskan Native"=5,
  51.                               "Other"=6),
  52.                   selected = "White"),
  53.      
  54.       # Select gender
  55.       selectInput(inputId = "gender",
  56.                   label = "Select your gender:",
  57.                   choices = c("Male" = 0,
  58.                               "Female" = 1),
  59.                   selected = 0),
  60.      
  61.       #Select if vetran or not
  62.       checkboxInput(inputId = "vetran",
  63.                     label = "Check if you ever served on active duty in the United States Armed Forces"),
  64.      
  65.       # Mark all of the ACEs you have experiences
  66.       checkboxGroupInput(inputId = "aces",
  67.                          label = "Check all of the following that you experienced between the ages of 0 and 18:",
  68.                          choices = c( "Lived with someone who was depressed, mentally ill, or suicidal" = 1,
  69.                                       "Lived with someone who was a problem drinker or alcoholic"= 2,
  70.                                       "Lived with someone who used illegal street drugs or who abused prescription medications" = 3,
  71.                                       "Live with someone who served time or was sentenced to serve time in a prison, jail, or other correctional facility"= 4,
  72.                                       "Parents separated or divorced" = 4,
  73.                                       "Parents or adults in your home slapped, hit, kicked, punched or beat each other up" = 6,
  74.                                       "Parent or adult in your home hit, beat, kicked, or physically hurt you in any way" = 7,
  75.                                       "Parent or adult in your home swore at you, insulted you, or put you down" = 8,
  76.                                       "Someone at least 5 years older than you touched you sexually" = 9,
  77.                                       "Someone at least 5 years older than you tried to make you touch them sexually" =10,
  78.                                       "Someone at least 5 years older than you forced you to have sex" =11)),
  79.      
  80.      
  81.       #Input age
  82.       numericInput(inputId = "age",
  83.                    label = "How old are you?",
  84.                    value = 18,
  85.                    min = 18,
  86.                    max = 100,
  87.                    step = 1),
  88.      
  89.       # Select level of education
  90.       selectInput(inputId = "education",
  91.                   label = "Select the highest grade or year of school you have completed",
  92.                   choices =c("Never attended school or only kindergarten" = 1,
  93.                              "Grades 1 through 8 (Elementary)" = 2,
  94.                              "Grades 9 through 11 (Some high school)" = 3,
  95.                              "Grade 12 or GED (High school graduate)" = 4,
  96.                              "College 1 year to 3 years (Some college or technical school)" = 5,
  97.                              "College 4 years or more (College graduate)" = 6)),
  98.      
  99.       # Select income level
  100.       selectInput(inputId = "income",
  101.                   label = "What is your annual household income (from all sources)?",
  102.                   choices = c("Less than $10,000" = 1,
  103.                               "Between $10,000 and $15,000" = 2,
  104.                               "Between $15,000 and $20,000" = 3,
  105.                               "Between $20,000 and $25,000" = 4,
  106.                               "Between $25,000 and $35,000" = 5,
  107.                               "Between $35,000 and $50,000" = 6,
  108.                               "Between $50,000 and $75,000" = 7,
  109.                               "$75,000 or more" = 8))
  110.      
  111.     ),
  112.    
  113.     # Outputs
  114.     mainPanel(
  115.       uiOutput(outputId = "nnet")
  116.       #,br(),
  117.       #plotOutput(outputId = "bar")
  118.      
  119.     )
  120.   )
  121. )
  122.  
  123. # Define server function
  124. server <- function(input, output) {
  125.   # Define some reactive components
  126.   # These use the inputs to create vectors that are used in the neural net prediction
  127.  
  128.  
  129.   numbers <- reactive({
  130.     validate(
  131.       need(is.numeric(input$age), "Please input your age (in numbers)")
  132.     )
  133.   })
  134.  
  135.   # aces reactive
  136.   aces_reactive <- reactive({
  137.     aces_list <- replicate(11, 0)
  138.     aces_list[as.integer(input$aces)] = 1
  139.     return(aces_list)
  140.   })
  141.  
  142.   #vetran reactive
  143.   vetran_reactive <- reactive({
  144.     ifelse(input$vetran, vetran_value <- 1, vetran_value <- 0)
  145.     return(vetran_value)
  146.   })
  147.  
  148.   # race reactive
  149.   race_reactive <- reactive({
  150.     vec <- replicate(6, 0)
  151.     vec[(as.integer(input$race))]=1
  152.     return(vec)})
  153.  
  154.   # define the neural network model and python
  155.   source_python("keras_saved_model_update.py")
  156.   py_run_file("keras_saved_model_update.py")
  157.  
  158.   #A REACTIVE VALUE TO TELL ME WHICH predict function to use then just call that, deifned by input
  159.   #will NEED TO ADD MORE here
  160.   #function reactive
  161.   func <- reactive({
  162.    
  163.     if (input$health_outcome == "Overweight") {
  164.       return(predict_overweight_nn)
  165.     }
  166.     if (input$health_outcome == "Anxiety") {
  167.       return(predict_anxiety_nn)
  168.     }
  169.   })
  170.  
  171.   age_reactive <- reactive({
  172.     age <- (input$age-18)/(99-18)
  173.     return(age)
  174.   })
  175.  
  176.   #score reactive
  177.   score_reactive <- reactive({
  178.     # uses neural net to predict p(outcome) given the information
  179.     predictions = c(aces_reactive(),vetran_reactive(),age_reactive(),input$education,input$income,input$gender,race_reactive())
  180.     score <- (func()(predictions))
  181.     return((score))
  182.   })
  183.  
  184.   none_reactive <- reactive({
  185.     # uses neural net to predict p(overwieght) given the same demographics but no ACEs
  186.     pred_none = c(replicate(11, 0),vetran_reactive(),age_reactive(),input$education,input$income,input$gender,race_reactive())
  187.     score_none <- (func()(pred_none))
  188.     score_none <- (score_none)
  189.     return(score_none)
  190.   })
  191.  
  192.   relative_reactive <- reactive({
  193.     relative <- (score_reactive()/none_reactive())
  194.     return(relative)
  195.   })
  196.  
  197.   #may end up getting rid of this but right now the graphic relies on it
  198.   diff_reactive <- reactive({
  199.     # # calculates difference in real value and if with no ACEs
  200.     diff <- ((score_reactive())-none_reactive())
  201.     return(diff)
  202.   })
  203.  
  204.   names_reactive <- reactive({
  205.     if (input$health_outcome == "Overweight") {
  206.       return("being overweight")
  207.     }
  208.     if (input$health_outcome == "Anxiety") {
  209.       return("having clinical anxiety")
  210.     }
  211.   })
  212.  
  213.   incdec_reactive <- reactive({
  214.     if (relative_reactive()-1 > 0) {
  215.       return("higher than")
  216.     }
  217.     if (relative_reactive()-1 < 0) {
  218.       return("lower than")
  219.     }
  220.     if (relative_reactive()-1 == 0) {
  221.       return("which is the same as")
  222.     }
  223.   })
  224.  
  225.   incdecnew_reactive <- reactive({
  226.     if (relative_reactive()-1 > 0) {
  227.       return(paste(percent(relative_reactive()-1)," higher than",sep=""))
  228.       return("higher than")
  229.     }
  230.     if (relative_reactive()-1 < 0) {
  231.       return(paste(percent(relative_reactive()-1)," lower than",sep=""))
  232.     }
  233.     if (relative_reactive()-1 == 0) {
  234.       return("the same as")
  235.     }
  236.   })
  237.  
  238.  
  239.  
  240.   # create the output of the app
  241.   output$nnet <- renderUI({
  242.    
  243.     # gives a custom error message if a number is not entered in the age box
  244.     numbers()
  245.    
  246.     if (sum(aces_reactive()) > 0){
  247.       paste("According to the model and given your information your risk for",
  248.             names_reactive(),
  249.             "is: ",
  250.             paste(percent(score_reactive()),".",sep=""),
  251.             "This risk is",
  252.             incdecnew_reactive(),
  253.             "it would be relative to if you had 0 ACEs.")
  254.     } else {
  255.       paste("According to the model and given your information your risk for",
  256.             names_reactive(),
  257.             "is: ",
  258.             paste(percent(score_reactive()),".",sep=""))
  259.     }
  260.     })
  261.  
  262.  
  263.  
  264.   #this makes the visualization
  265.   #it would be better to have the names
  266.   #can bring this back but right now it feels irrelevant
  267.   # output$bar <- renderPlot({
  268.   #   viz <- data.frame(Type = c(paste("Probability of not",names_reactive()), paste("Increased probability of",names_reactive(), "given selected ACEs"), paste("Probability of", names_reactive(), "with your demographics and no ACEs")),
  269.   #                     Proportion = c((1-score_reactive()), diff_reactive(), (score_reactive()-diff_reactive())))
  270.   #   viz <- viz %>%
  271.   #     mutate(ace = "Probability of Being Overweight")
  272.   #  
  273.   #   viz$Type <- factor(viz$Type, levels = viz$Type[c(0:3)])
  274.   #  
  275.   #   ggplot(viz, aes(x = ace, y = Proportion, fill = Type)) +
  276.   #     geom_col() +
  277.   #     coord_flip() +
  278.   #     #could prob just put in percent(number) instead of proportion + % and hopefully would work
  279.   #     geom_text(aes(label = paste0(percent(Proportion))),
  280.   #               position = position_stack(vjust = 0.5)) +
  281.   #     scale_fill_brewer(palette = "Set2") +
  282.   #     theme_minimal(base_size = 14) +
  283.   #     ylab("Percentage") +
  284.   #     xlab(NULL)
  285.   #  
  286.   # })
  287. }
  288.  
  289. # Create a Shiny app object
  290. shinyApp(ui = ui, server = server)
RAW Paste Data
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy. OK, I Understand
 
Top