API tools faq
paste
Guest User

Untitled

a guest
Jul 22nd, 2018
68
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 21.21 KB | None | 0 0
raw download clone embed print report
  1. library(shiny) # shiny library
  2. # begining of ui component
  3. ui <- shinyUI(fluidPage(theme = "bootstrap.css",
  4. titlePanel("HDDF"),
  5. sidebarLayout(
  6. sidebarPanel(
  7. h3('Model selection panel'),
  8. # the actioButton called rpart which is the name of the variable you need to use in the server component
  9. actionButton('rpart', label = 'Decision Tree', class = "btn btn-success btn-lg"),
  10. actionButton('Neuralnet', label = 'Neuronal network', class = "btn btn-secondary btn-lg"),
  11. # the training sample split you allow the user to control on your model
  12. numericInput("ratio",
  13. h4("Training sample in %"),
  14. value = 50 / 100,
  15. min = 50 / 100,
  16. max = 90 / 100,
  17. step = 0.1
  18. ),
  19. numericInput(
  20. "size",
  21. h4("Size"),
  22. value = 5,
  23. min = 0,
  24. max = 10,
  25. step = 0.5
  26. ),
  27. numericInput(
  28. "decay",
  29. h4("Decay"),
  30. value = 0.1,
  31. min = 0,
  32. max = 0.9,
  33. step = 0.1
  34. )
  35. ),
  36. # this is how you create many "tabs" for the output from ML models
  37. mainPanel(tabsetPanel(
  38. tabPanel(
  39. h4(tags$label("Application form")),
  40. fluidRow(column(width=3,
  41. sliderInput(
  42. "Edad",
  43. h3("Age (years)"),
  44. min = 19,
  45. max = 72,
  46. value = 20
  47. )),
  48.  
  49. column(width=3,
  50. radioButtons(
  51. "Estado_civil_sexo",
  52. h3("Marital Status/Sex"),
  53. choices = list(
  54. "Male divorced/living apart" = "1",
  55. "Male Single" = "2",
  56. "Male married/widowed" = "3",
  57. "Female single" = "4"
  58. )
  59. )),
  60.  
  61. column(width = 3,
  62. radioButtons(
  63. "Tiempo_empleo",
  64. h3("Employed"),
  65. choices = list(
  66. "Unemployed" = "1",
  67. "<= 1 year" = "2",
  68. "1-4 years" = "3",
  69. "4-7 years" = "4",
  70. ">=7 years" = "5"
  71. )
  72. )),
  73.  
  74. column(width = 3,
  75. radioButtons(
  76. "Trabajo",
  77. h3("Occupation"),
  78. choices = list(
  79. "Unemployed/Unskilled/no residence" = "1",
  80. "Unskilled resident" = "2",
  81. "Skilled worker" = "3",
  82. "self-employed" = "4"
  83. )
  84. )
  85. )),
  86.  
  87. fluidRow(column(width = 3,
  88. radioButtons(
  89. "Trabajador_extranjero",
  90. h3("Foreign worker"),
  91. choices = list("Yes" = "1",
  92. "No" = "2")
  93. )
  94. ),
  95.  
  96. column(width = 3,
  97. radioButtons(
  98. "Dependientes",
  99. h3("Number of persons to maintenance"),
  100. choices = list("0 to 2" = "2",
  101. "3 and more" = "1")
  102. )),
  103.  
  104. column(width = 3,
  105. radioButtons(
  106. "Propiedad",
  107. h3("Most valuable available assets"),
  108. choices = list(
  109. "Ownership of house or land " = "4",
  110. "Life insurance" = "3",
  111. "Car/other" = "2",
  112. "Nor availabre/No assets" = "1"
  113. )
  114. )),
  115.  
  116. column(width = 3,
  117. radioButtons(
  118. "Alojamiento",
  119. h3("Type of apartment"),
  120. choices = list(
  121. "Rented falt" = "2",
  122. "Owner-occupied flat" = "3",
  123. "Free apartment" = "1"
  124. )
  125. )
  126. )),
  127.  
  128. fluidRow(column(width = 3,
  129. radioButtons(
  130. "Tiempo_residencia",
  131. h3("Living in current household for"),
  132. choices = list(
  133. "< 1 year" = "1",
  134. "1-4 years" = "2",
  135. "4-7 years" = "3",
  136. ">=7 years" = "4"
  137. )
  138. )),
  139.  
  140. column(width = 3,
  141. radioButtons(
  142. "Tasa",
  143. h3("Instalment in % of available income"),
  144. choices = list(
  145. "<20" = "4",
  146. "20-25" = "3",
  147. "25-35" = "2",
  148. ">=35" = "1"
  149. )
  150. )),
  151.  
  152. column(width = 3,
  153. radioButtons(
  154. "Telefono",
  155. h3("Telephone"),
  156. choices = list("Yes" = "2",
  157. "No" = "1")
  158. )),
  159.  
  160. column(width = 3,
  161. radioButtons(
  162. "Estado_cuenta",
  163. h3("Balance of current account"),
  164. choices = list(
  165. "No balance or debit" = "2",
  166. "0- 200 DM" = "3",
  167. ">=200" = "4",
  168. "No running account" = "1"
  169. )
  170. )
  171. )),
  172.  
  173. fluidRow(column(width = 3,
  174. sliderInput(
  175. "Duracion_credito",
  176. h3("Duration credit in months"),
  177. min = 4,
  178. max = 72,
  179. value = 5
  180. )
  181. ),
  182.  
  183. column(width = 3,
  184. radioButtons(
  185. "Historial_crediticio",
  186. h3("Payment of previous credits"),
  187. choices = list(
  188. "No credits/all paid" = "2",
  189. "Paid back previous credits at bank" = "4",
  190. "No problems with current credits at bank" = "3",
  191. "Hesitant payment of previous credits" = "0",
  192. "problematic running account" = "1"
  193. )
  194. )
  195. ),
  196.  
  197. column(width = 3,
  198. radioButtons(
  199. "N_creditos",
  200. h3("Number of previous credits at this bank"),
  201. choices = list(
  202. "One" = "1",
  203. "two or three" = "2",
  204. "four or five" = "3",
  205. "Six or more" = "4"
  206. )
  207. )),
  208. column(width = 3,
  209. radioButtons(
  210. "Proposito",
  211. h3("Purpose"),
  212. choices = list(
  213. "New car" = "1",
  214. "Used car" = "2",
  215. "items of furiture" = "3",
  216. "Radio/TV" = "4",
  217. "Household appliances" = "5",
  218. "Education" = "6",
  219. "Vacation" = "8",
  220. "Retraining" = "9",
  221. "Business" = "10",
  222. "Other" = "0"
  223. )
  224. )
  225. )),
  226.  
  227. fluidRow(column(width = 3,
  228. sliderInput(
  229. "Monto_credito",
  230. h3("Amount of credit"),
  231. min = 338,
  232. max = 18424,
  233. value = 270
  234. )
  235. ),
  236.  
  237. column(width = 3,
  238. radioButtons(
  239. "Cuenta_ahorros",
  240. h3("Value of savings or stocks"),
  241. choices = list(
  242. "<100 EUR" = "2",
  243. "100-499 EUR" = "3",
  244. "500-999 EUR" = "4",
  245. ">=1000 EUR" = "5",
  246. "not available" = "1"
  247. )
  248. )),
  249.  
  250. column(width = 3,
  251. radioButtons(
  252. "Deudor",
  253. h3("Further debtors/Guarantors"),
  254. choices = list(
  255. "None" = "1",
  256. "Co applicant" = "2",
  257. "Guarantor" = "3"
  258. )
  259. )),
  260. column(width = 3,
  261. radioButtons(
  262. "Planes_pago",
  263. h3("Further running credits"),
  264. choices = list(
  265. "At other banks" = "1",
  266. "At department store or mail order house" = "2",
  267. "No futher running credits" = "3"
  268. )
  269. ))
  270. )
  271. ),
  272. tabPanel(h4(tags$label("Data")),
  273. tableOutput("head")
  274. ),
  275. tabPanel(
  276. h4(tags$label("Decision Tree")),
  277. tags$div(style="height:200px; padding-left:40%;",
  278. imageOutput("image1", height = 150)
  279. ),
  280. tags$h4(align="center",
  281. tableOutput("result_a")
  282. ),
  283. plotOutput("result_2")
  284. ),
  285. tabPanel(
  286. h4(tags$label("Neural network")),
  287. tags$div(style="height:200px; padding-left:40%;",
  288. imageOutput("image2", height = 150)
  289. ),
  290. tags$h4(align="center",
  291. tableOutput("result_B")
  292. ),
  293. plotOutput("result_4")
  294. )
  295.  
  296. )
  297. ))
  298. )
  299. )
  300.  
  301. # all the libraries you need for your machine learning models and plots
  302. library(rpart) # Popular decision tree algorithm
  303. library(rpart.plot) # Enhanced tree plots
  304. library(nnet)
  305. library(neuralnet)
  306. library(png) # For writePNG function
  307.  
  308. load("D:/emely/Desktop/TFM/dataModelo.Rdata", envir = environment())
  309.  
  310.  
  311. # begining of your server component
  312. server <- function(input, output, session) {
  313. data.test <- function() {
  314. return(
  315. data.frame(
  316. "Estado_cuenta" = as.numeric(input$Estado_cuenta),
  317. "Duracion_credito" = input$Duracion_credito,
  318. "Historial_crediticio" = as.numeric(input$Historial_crediticio),
  319. "Proposito" = as.numeric(input$Proposito),
  320. "Monto_credito" = input$Monto_credito,
  321. "Cuenta_ahorros" = as.numeric(input$Cuenta_ahorros),
  322. "Tiempo_empleo" = as.numeric(input$Tiempo_empleo),
  323. "Tasa" = as.numeric(input$Tasa),
  324. "Estado_civil_sexo" = as.numeric(input$Estado_civil_sexo),
  325. "Deudor" = as.numeric(input$Deudor),
  326. "Tiempo_residencia" = as.numeric(input$Tiempo_residencia),
  327. "Propiedad" = as.numeric(input$Propiedad),
  328. "Edad" = input$Edad,
  329. "Planes_pago" = as.numeric(input$Planes_pago),
  330. "Alojamiento" = as.numeric(input$Alojamiento),
  331. "N_creditos" = as.numeric(input$N_creditos),
  332. "Trabajo" = as.numeric(input$Trabajo),
  333. "Dependientes" = as.numeric(input$Dependientes),
  334. "Telefono" = as.numeric(input$Telefono),
  335. "Trabajador_extranjero" = as.numeric(input$Trabajador_extranjero),
  336. row.names = "Value"
  337. )
  338. )
  339. }
  340.  
  341. observe({
  342. # this is how you fetch the input variable=ratio from ui component
  343. r <- input$ratio
  344. size <- input$size
  345. decay <- input$decay
  346. # construct your train and test set for machine learning models
  347. ind <- sample(2, nrow(data), replace = TRUE, prob = c(r, 1 - r))
  348. trainset = data[ind == 1, ]
  349. testset = data.test()
  350.  
  351. # decision tree action button
  352. observeEvent(input$rpart, {
  353. ml_rpart <- rpart(trainset$clase ~ ., method = 'class', data = trainset)
  354. model_pred <- predict(ml_rpart, testset, type = "class")
  355. output$result <- renderPrint(model_pred)
  356.  
  357. output$result_a<-renderPrint({
  358. if (model_pred == "F") {
  359. show('INVALID TRANSACTION')
  360. }
  361. else if (model_pred == "NF") {
  362. show("VALID TRANSACTION")
  363. }
  364. })
  365.  
  366.  
  367. output$image1 <- renderImage({
  368. if (model_pred == "F") {
  369. return(list(
  370. src = "images/F.png",
  371. contentType = "image/png",
  372. alt = "F"
  373. ))
  374. } else if (model_pred == "NF") {
  375. return(list(
  376. src = "images/NF.png",
  377. filetype = "image/png",
  378. alt = "NF"
  379. ))
  380. }
  381.  
  382. }, deleteFile = FALSE)
  383.  
  384. output$result_2 <- renderPlot(rpart.plot(ml_rpart, cex = 0.8))
  385. })
  386. # neural network action button
  387. observeEvent(input$Neuralnet, {
  388. fit <- nnet(
  389. clase ~ .,
  390. size = size,
  391. decay = decay,
  392. trace = F,
  393. data = trainset
  394. )
  395.  
  396. ann <-
  397. neuralnet(
  398. as.numeric(clase) ~ Estado_cuenta + Duracion_credito + Historial_crediticio +
  399. Proposito +
  400. Monto_credito + Cuenta_ahorros + Tiempo_empleo + Tasa + Estado_civil_sexo +
  401. Deudor + Tiempo_residencia + Propiedad + Edad + Planes_pago + Alojamiento +
  402. N_creditos + Trabajo + Dependientes + Telefono + Trabajador_extranjero ,
  403. data = trainset,
  404. hidden = 1,
  405. linear.output = FALSE,
  406. threshold = 0.01,
  407. rep = 1
  408. )
  409. pred <- predict(fit, testset, type = "class")
  410. output$result_3 <- renderPrint(pred)
  411.  
  412. output$result_B<-renderPrint({
  413. if (pred == "F") {
  414. show('INVALID TRANSACTION')
  415. }
  416. else if (pred == "NF") {
  417. show("VALID TRANSACTION")
  418. }
  419. })
  420.  
  421.  
  422. output$image2 <- renderImage({
  423. if (pred == "F") {
  424. return(list(
  425. src = "images/F.png",
  426. contentType = "image/png",
  427. alt = "F"
  428. ))
  429. } else if (pred == "NF") {
  430. return(list(
  431. src = "images/NF.png",
  432. filetype = "image/png",
  433. alt = "NF"
  434. ))
  435. }
  436.  
  437. }, deleteFile = FALSE)
  438.  
  439. output$result_4 <-renderPlot(plot(ann, rep = "best", cex = 0.9))
  440. })
  441.  
  442. #print dataframe's sample head
  443. output$head <- renderTable({
  444. t(data.test())}, hover = TRUE, striped = TRUE, bordered = TRUE,
  445. spacing = c("s"),
  446. align = "c", rownames = TRUE, colnames = TRUE
  447. )
  448. })
  449.  
  450.  
  451. }
  452.  
  453.  
  454.  
  455. shinyApp(ui = ui, server = server) # you call shiny all like this
  456.  
  457. # free server shinyapps.io
Add Comment
Please, Sign In to add comment
Public Pastes
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
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!