Advertisement
Guest User

Untitled

a guest
Mar 21st, 2019
116
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 10.29 KB | None | 0 0
  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)
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement