daily pastebin goal
83%
SHARE
TWEET

Untitled

a guest Mar 25th, 2019 58 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.                               "Asthma",
  40.                               "Binge Drinking",
  41.                               "Diabetes",
  42.                               "Depression",
  43.                               "Smoking"),
  44.                   selected = "Overweight"),
  45.      
  46.       h3("Demographics and ACE Data", align = "center"),
  47.      
  48.       # Select race
  49.       selectInput(inputId = "race",
  50.                   label = "Select your race:",
  51.                   choices = c("White"=1,
  52.                               "Black"=2,
  53.                               "Asian"=3,
  54.                               "Native Hawaiian or other Pacific Islander"=4,
  55.                               "American Indian or Alaskan Native"=5,
  56.                               "Other"=6),
  57.                   selected = "Other"),
  58.      
  59.       # Select gender
  60.       selectInput(inputId = "gender",
  61.                   label = "Select your gender:",
  62.                   choices = c("Male" = 0,
  63.                               "Female" = 1),
  64.                   selected = 1),
  65.      
  66.       #Select if vetran or not
  67.       checkboxInput(inputId = "vetran",
  68.                     label = "Check if you ever served on active duty in the United States Armed Forces"),
  69.      
  70.       # Mark all of the ACEs you have experiences
  71.       checkboxGroupInput(inputId = "aces",
  72.                          label = "Check all of the following that you experienced between the ages of 0 and 18:",
  73.                          choices = c( "Lived with someone who was depressed, mentally ill, or suicidal" = 1,
  74.                                       "Lived with someone who was a problem drinker or alcoholic"= 2,
  75.                                       "Lived with someone who used illegal street drugs or who abused prescription medications" = 3,
  76.                                       "Live with someone who served time or was sentenced to serve time in a prison, jail, or other correctional facility"= 4,
  77.                                       "Parents separated or divorced" = 4,
  78.                                       "Parents or adults in your home slapped, hit, kicked, punched or beat each other up" = 6,
  79.                                       "Parent or adult in your home hit, beat, kicked, or physically hurt you in any way" = 7,
  80.                                       "Parent or adult in your home swore at you, insulted you, or put you down" = 8,
  81.                                       "Someone at least 5 years older than you touched you sexually" = 9,
  82.                                       "Someone at least 5 years older than you tried to make you touch them sexually" =10,
  83.                                       "Someone at least 5 years older than you forced you to have sex" =11)),
  84.      
  85.      
  86.       #Input age
  87.       numericInput(inputId = "age",
  88.                    label = "How old are you?",
  89.                    value = 18,
  90.                    min = 18,
  91.                    max = 100,
  92.                    step = 1),
  93.      
  94.       # Select level of education
  95.       selectInput(inputId = "education",
  96.                   label = "Select the highest grade or year of school you have completed",
  97.                   choices =c("Never attended school or only kindergarten" = 1,
  98.                              "Grades 1 through 8 (Elementary)" = 2,
  99.                              "Grades 9 through 11 (Some high school)" = 3,
  100.                              "Grade 12 or GED (High school graduate)" = 4,
  101.                              "College 1 year to 3 years (Some college or technical school)" = 5,
  102.                              "College 4 years or more (College graduate)" = 6)),
  103.      
  104.       # Select income level
  105.       selectInput(inputId = "income",
  106.                   label = "What is your annual household income (from all sources)?",
  107.                   choices = c("Less than $10,000" = 1,
  108.                               "Between $10,000 and $15,000" = 2,
  109.                               "Between $15,000 and $20,000" = 3,
  110.                               "Between $20,000 and $25,000" = 4,
  111.                               "Between $25,000 and $35,000" = 5,
  112.                               "Between $35,000 and $50,000" = 6,
  113.                               "Between $50,000 and $75,000" = 7,
  114.                               "$75,000 or more" = 8))
  115.      
  116.     ),
  117.    
  118.     # Outputs
  119.     mainPanel(
  120.       uiOutput(outputId = "nnet")
  121.       #,br(),
  122.       #consider how we are going to add text and what it will be
  123.       #compared to people who are like you
  124.       #plotOutput(outputId = "bar")
  125.      
  126.     )
  127.   )
  128. )
  129.  
  130. # Define server function
  131. server <- function(input, output) {
  132.   # Define some reactive components
  133.   # These use the inputs to create vectors that are used in the neural net prediction
  134.  
  135.  
  136.   numbers <- reactive({
  137.     validate(
  138.       need(is.numeric(input$age), "Please input your age (in numbers)")
  139.     )
  140.   })
  141.  
  142.   # aces reactive
  143.   aces_reactive <- reactive({
  144.     aces_list <- replicate(11, 0)
  145.     aces_list[as.integer(input$aces)] = 1
  146.     return(aces_list)
  147.   })
  148.  
  149.   #vetran reactive
  150.   vetran_reactive <- reactive({
  151.     ifelse(input$vetran, vetran_value <- 1, vetran_value <- 0)
  152.     return(vetran_value)
  153.   })
  154.  
  155.   # race reactive
  156.   race_reactive <- reactive({
  157.     vec <- replicate(6, 0)
  158.     vec[(as.integer(input$race))]=1
  159.     return(vec)})
  160.  
  161.   # define the neural network model and python
  162.   source_python("testing the models new.py")
  163.   py_run_file("testing the models new.py")
  164.  
  165.   #A REACTIVE VALUE TO TELL ME WHICH predict function to use then just call that, deifned by input
  166.   #will NEED TO ADD MORE here
  167.   #function reactive
  168.   func <- reactive({
  169.    
  170.     if (input$health_outcome == "Overweight") {
  171.       return(predict_overweight_nn)
  172.     }
  173.     if (input$health_outcome == "Anxiety") {
  174.       return(predict_anxiety_nn)
  175.     }
  176.     if (input$health_outcome == "Asthma") {
  177.       return(predict_asthma_nn)
  178.     }
  179.     if (input$health_outcome == "Binge Drinking") {
  180.       return(predict_binge_drinking_nn)
  181.     }
  182.     if (input$health_outcome == "Diabetes") {
  183.       return(predict_diabetes_nn)
  184.     }
  185.     if (input$health_outcome == "Depression") {
  186.       return(predict_diabetes_nn)
  187.     }
  188.     if (input$health_outcome == "Smoking") {
  189.       return(predict_anxiety_nn)
  190.     }
  191.   })
  192.  
  193.   age_reactive <- reactive({
  194.     age <- (input$age-18)/(99-18)
  195.     return(age)
  196.   })
  197.  
  198.   #score reactive
  199.   #still need this, this is for with ACEs
  200.   score_reactive <- reactive({
  201.     # uses neural net to predict p(outcome) given the information
  202.     predictions = c(aces_reactive(),vetran_reactive(),age_reactive(),input$education,input$income,input$gender,race_reactive())
  203.     score <- (func()(predictions))
  204.     return((score))
  205.   })
  206.  
  207.   #still need this, this is for no ACEs
  208.   none_reactive <- reactive({
  209.     # uses neural net to predict p(overwieght) given the same demographics but no ACEs
  210.     pred_none = c(replicate(11, 0),vetran_reactive(),age_reactive(),input$education,input$income,input$gender,race_reactive())
  211.     score_none <- (func()(pred_none))
  212.     score_none <- (score_none)
  213.     return(score_none)
  214.   })
  215.  
  216.   #make a reactive for yes with ACEs
  217.   with_aces_reactive <- reactive({
  218.     x <- score_reactive()
  219.     if(0 <=x && x < 0.05){
  220.       return("very unlikely")
  221.     }
  222.     if(0.05 <=x && x < 0.25){
  223.       return("unlikely")
  224.     }
  225.     if(0.25 <=x && x < 0.75){
  226.       return("moderately likely")
  227.     }
  228.     if(0.75 <=x && x < 0.95){
  229.       return("likely")
  230.     }
  231.     if(0.95 <=x && x <= 1){
  232.       return("very likely")
  233.     }
  234.    
  235.   })
  236.  
  237.   #make a reactive for without ACEs
  238.  
  239.  
  240.   #won't need this...sad
  241.   relative_reactive <- reactive({
  242.     relative <- (score_reactive()/none_reactive())
  243.     return(relative)
  244.   })
  245.  
  246.   #may end up getting rid of this but right now the graphic relies on it
  247.   diff_reactive <- reactive({
  248.     # # calculates difference in real value and if with no ACEs
  249.     diff <- ((score_reactive())-none_reactive())
  250.     return(diff)
  251.   })
  252.  
  253.   #gotta change these too
  254.   #your risk for
  255.   names_reactive <- reactive({
  256.     if (input$health_outcome == "Overweight") {
  257.       return("being overweight")
  258.     }
  259.     if (input$health_outcome == "Anxiety") {
  260.       return("having clinical anxiety")
  261.     }
  262.     if (input$health_outcome == "Asthma") {
  263.       return("having asthma")
  264.     }
  265.     if (input$health_outcome == "Binge Drinking") {
  266.       return("binge drinking")
  267.     }
  268.     if (input$health_outcome == "Depression") {
  269.       return("having clinical depression")
  270.     }
  271.     if (input$health_outcome == "Diabetes") {
  272.       return("having diabetes")
  273.     }
  274.     if (input$health_outcome == "Smoking") {
  275.       return("smoking cigarettes")
  276.     }
  277.   })
  278.  
  279.   #this will go
  280.   incdec_reactive <- reactive({
  281.     if (relative_reactive()-1 > 0) {
  282.       return("higher than")
  283.     }
  284.     if (relative_reactive()-1 < 0) {
  285.       return("lower than")
  286.     }
  287.     if (relative_reactive()-1 == 0) {
  288.       return("which is the same as")
  289.     }
  290.   })
  291.  
  292.   #this will go
  293.   incdecnew_reactive <- reactive({
  294.     if (relative_reactive()-1 > 0) {
  295.       return(paste(percent(relative_reactive()-1)," higher than",sep=""))
  296.       return("higher than")
  297.     }
  298.     if (relative_reactive()-1 < 0) {
  299.       return(paste(percent(abs(relative_reactive()-1))," lower than",sep=""))
  300.     }
  301.     if (relative_reactive()-1 == 0) {
  302.       return("the same as")
  303.     }
  304.   })
  305.  
  306.  
  307.  
  308.   # create the output of the app
  309.   output$nnet <- renderUI({
  310.    
  311.     # gives a custom error message if a number is not entered in the age box
  312.     numbers()
  313.    
  314.     if (sum(aces_reactive()) > 0){
  315.       paste("According to the model and given your information your risk for",
  316.             names_reactive(),
  317.             "is: ",
  318.             paste(with_aces_reactive(),".",sep=""),
  319.             "This risk is",
  320.             incdecnew_reactive(),
  321.             "it would be relative to if you had 0 ACEs.")
  322.     } else {
  323.       paste("According to the model and given your information your risk for",
  324.             names_reactive(),
  325.             "is: ",
  326.             paste(percent(score_reactive()),".",sep=""))
  327.     }
  328.   })
  329.  
  330.  
  331.  
  332.   #this makes the visualization
  333.   #it would be better to have the names
  334.   #can bring this back but right now it feels irrelevant
  335.   # output$bar <- renderPlot({
  336.   #   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")),
  337.   #                     Proportion = c((1-score_reactive()), diff_reactive(), (score_reactive()-diff_reactive())))
  338.   #   viz <- viz %>%
  339.   #     mutate(ace = "Probability of Being Overweight")
  340.   #  
  341.   #   viz$Type <- factor(viz$Type, levels = viz$Type[c(0:3)])
  342.   #  
  343.   #   ggplot(viz, aes(x = ace, y = Proportion, fill = Type)) +
  344.   #     geom_col() +
  345.   #     coord_flip() +
  346.   #     #could prob just put in percent(number) instead of proportion + % and hopefully would work
  347.   #     geom_text(aes(label = paste0(percent(Proportion))),
  348.   #               position = position_stack(vjust = 0.5)) +
  349.   #     scale_fill_brewer(palette = "Set2") +
  350.   #     theme_minimal(base_size = 14) +
  351.   #     ylab("Percentage") +
  352.   #     xlab(NULL)
  353.   #  
  354.   # })
  355.  
  356. }
  357.  
  358. # Create a Shiny app object
  359. 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