Advertisement
Guest User

Untitled

a guest
Jan 20th, 2017
184
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 10.80 KB | None | 0 0
  1. ---
  2. title: "PDNA_version_2"
  3. output: flexdashboard::flex_dashboard
  4. runtime: shiny
  5. ---
  6.  
  7. ```{r setup, include=FALSE}
  8.  
  9. # Hrant's to do
  10. # 1) stop Filer's autowidth
  11. # 2) enable scroll down to see Use Default
  12. # 3) add the Radiobutton and correct the IF in losses
  13. # 4) take values from Marz inputs
  14. # 5) SUM damages & losses for communities
  15. # 6) solve the as.numeric(ac.character) issue in other way (for calculations)
  16.  
  17. library("shiny")
  18. library("flexdashboard")
  19. library("DT")
  20. library("rhandsontable")
  21. library("shinyjs")
  22. ```
  23.  
  24. Community
  25. =====================================
  26.  
  27.  
  28. Column {.sidebar}
  29. -----------------------------------------------------------------------
  30.  
  31. [comment]:(**Create disaster event**)
  32.  
  33. ```{r}
  34. br()
  35. #useShinyjs(rmd=TRUE)
  36. actionButton("event","Create Disaster Event", width = '100%',
  37. style = "background-color: grey; border-color: grey")
  38. conditionalPanel(condition = "input.event %2 == 1 && input.newentry %2 == 0",
  39. dateRangeInput("date", "Date input", start = NULL, end=NULL),
  40. selectizeInput("marz",label="Marz",choices=list("","Shirak","Armavir","Ararat"),selected=NULL),
  41. selectizeInput("disaster", label = "Disaster",choices = list("","Hail", "Frost","Drought"), selected = 1),
  42. textAreaInput("description",label = "Description",height = '200px'))
  43.  
  44. br()
  45. actionButton("newentry","Create a new entry",width = '100%',
  46. style = "background-color: grey; border-color: grey")
  47. br()
  48. conditionalPanel(condition = "input.newentry %2 === 1 && input.event %2 == 1",
  49. textInput("name", label = "Name",placeholder = "Please enter farmer's full name"),
  50. selectInput("affect", label ="Disaster effects", multiple = TRUE,
  51. choices = list("","Annual crops", "Trees and Bushes","Livestock"), selected = NULL),
  52. selectizeInput("community",label="Community",choices=list("","Qarakert","Dalarik","Other"),selected=NULL))
  53. ```
  54.  
  55. Column {.tabset .tabset-fade}
  56. -----------------------------------------------------------------------
  57.  
  58. ### Specific inputs
  59.  
  60. ```{r, echo=FALSE}
  61.  
  62. uiOutput("ui")
  63.  
  64. crop_list <- sort(c("","Potato","Melon","Other"))
  65.  
  66. output$ui <- renderUI({
  67. if (is.null(input$affect))
  68. return()
  69.  
  70. # Depending on input$affect, we'll generate a different
  71. # UI component and send it to the client.
  72. switch(input$affect,
  73.  
  74. "Annual crops" = wellPanel(selectizeInput("crop", "Crop name",choices = crop_list,
  75. options = list(create = TRUE,
  76. placeholder = "Which crop was affected?")),
  77. conditionalPanel(condition ="input.crop!=''",
  78. selectInput("unit","Measurement Unit",
  79. choices = list("Ha","M2")),
  80. numericInput("lost", "Units lost", min = 0, value = 0),
  81. # radioButtons("replanting","Replanting possible",
  82. # choices = c("Yes","No"), inline=TRUE),
  83. fluidRow(column(6,numericInput("reduced","Units with Reduced Yield",
  84. min = 0, value = 0)),
  85. conditionalPanel(condition ="input.reduced >0",
  86. column(6, sliderInput("reduction","Share of Reduction",
  87. min = 0, step = 5, max = 100, value = 75)))),
  88. fluidRow(column(2,actionButton("default","Use Defaults",
  89. style = "background-color: #337ab7; border-color: #2e6da4")),
  90. column(2,actionButton("custom","Create Custom",
  91. style = "background-color: orange; border-color: orange")))
  92. )
  93. ),
  94. #h("Explanation text, mentioning that whole affected area for a crop is
  95. # lost + reduced")
  96. "Trees and Bushes" = fluidRow(
  97. column(3,
  98. wellPanel(numericInput("a", "A", value =5))),
  99. column(3,
  100. wellPanel(numericInput("a", "A", value =5))
  101. )),
  102. "Livestock" = fluidRow(
  103. column(3,
  104. wellPanel(numericInput("a", "A", value = 5))
  105. ))
  106. )
  107. })
  108.  
  109.  
  110. ```
  111.  
  112. ### Report table
  113.  
  114. ```{r, echo=FALSE}
  115. dataTableOutput("table")
  116.  
  117. fields <- c("date","community","disaster","name","affect","crop","unit","lost","reduced","reduction")
  118.  
  119. saveData <- function(data) {
  120. # Calculate Damages & Losses in the following row
  121. data <- as.data.frame(cbind(t(data),
  122. Damages=as.numeric(as.character(data[8]))*200,
  123. Losses=#as.numeric(as.character(data[9]))*200+
  124. as.numeric(as.character(data[9]))*200*as.numeric(as.character(data[10]))/100+
  125. as.numeric(as.character(data[9]))*0+
  126. as.numeric(as.character(data[8]))*20#+as.numeric(as.character(data[9]))*20-100
  127. ))
  128. if (exists("responses")) {
  129. responses <<- rbind(responses, data)
  130. } else {
  131. responses <<- data
  132. }
  133. }
  134.  
  135. # copied from JavaScript lib
  136. opts <- list(
  137. footerCallback = JS(
  138. "function( tfoot, data, start, end, display ) {",
  139. "var api = this.api();",
  140. "$( api.column( 5 ).footer() ).html(",
  141. "api.column( 5 ).data().reduce( function ( a, b ) {",
  142. "return a + b;",
  143. "} )",
  144. ");",
  145. "}"))
  146.  
  147.  
  148. loadData <- function() {
  149. if (exists("responses")) {
  150. responses[c(2,3,4,6,11,12)]
  151. }
  152. }
  153.  
  154. formData <- reactive({
  155. data <- sapply(fields, function(x) input[[x]])
  156. data
  157. })
  158.  
  159. # When the Default button is clicked, save the form data
  160. observeEvent(input$default, {
  161. saveData(formData())
  162. })
  163.  
  164.  
  165. # Show the previous responses
  166. # (update with current response when default is clicked)
  167. output$table <- DT::renderDataTable(filter = 'top', options = opts, {
  168. input$default
  169. loadData()
  170. })
  171. ```
  172.  
  173. ### Report table editable
  174.  
  175. ```{r, echo=FALSE}
  176. rHandsontableOutput('edit_table')
  177.  
  178. # Show the previous responses
  179. # (update with current response when default is clicked)
  180. output$edit_table <- renderRHandsontable({
  181. input$default
  182. DF=loadData()
  183. rhandsontable(
  184. if (!is.null(input$edit_table)) {
  185. DF = hot_to_r(input$edit_table)
  186. } else {
  187. DF = loadData()
  188. },selectCallback = TRUE,readOnly = FALSE)
  189. rhandsontable(DF) %>%
  190. hot_table(highlightCol = TRUE, highlightRow = TRUE)
  191. })
  192. ```
  193.  
  194. Marz
  195. =====================================
  196.  
  197. Column {.sidebar}
  198. -----------------------------------------------------------------------
  199.  
  200. ```{r, echo=FALSE}
  201. br()
  202. br()
  203. selectizeInput("components","Choose component to update",
  204. choices = c("Annual Crops","Trees and Bushes","Livestock"),
  205. options = list(create = TRUE, placeholder = "What you want to update?"))
  206. ```
  207.  
  208. Column {.tabset .tabset-fade}
  209. -----------------------------------------------------------------------
  210.  
  211. ### Set defaults
  212.  
  213. ```{r, echo=FALSE}
  214. uiOutput("componentui")
  215.  
  216. output$componentui <- renderUI({
  217. if (is.null(input$components))
  218. return()
  219.  
  220. switch(input$components,
  221.  
  222. "Annual Crops" = wellPanel(selectizeInput("thecrop", "Crop name",choices = crop_list,
  223. options = list(create = TRUE, placeholder = "Please enter the crop name")),
  224. selectInput("theunit", "Measurement Unit",
  225. choices = list("Ha", "units"), selected = NULL),
  226. numericInput("styield","Standard yearly income yield / unit",
  227. min = 0, value = 0),
  228. numericInput("repyield", "Replanted income yield / unit",min = 0, value = 0),
  229. numericInput("repcost","Replanting cost / unit",min = 0, value = 0),
  230. numericInput("reccost","Recovery cost / unit",min = 0, value = 0)
  231. ),
  232.  
  233. "Trees and Bushes" = wellPanel(
  234. selectizeInput("thetree","Crop type",choices ="",
  235. options = list(create=TRUE, placeholder = "Please enter the crop name")),
  236. selectInput("treeunit","Measurement Unit", choices = list("ha", "units"),
  237. selected = 1),
  238. numericInput("treestyield","Standard yearly income yield / unit",
  239. min = 0, value = 0),
  240. numericInput("treerepcost","Replanting cost / unit",min = 0, value = 0),
  241. numericInput("treemaincost","Maitanance cost / unit",min = 0, value = 0),
  242. numericInput("treereccost","Recovery cost / unit", min = 0, value = 0)
  243. ),
  244. "Livestock" = wellPanel()
  245. )
  246. })
  247.  
  248.  
  249. ```
  250.  
  251. ### Calculator
  252.  
  253. ```{r,echo=FALSE}
  254. uiOutput("calculators")
  255.  
  256. output$calculators <- renderUI({
  257. if (is.null(input$components))
  258. return()
  259.  
  260. switch(input$components,
  261.  
  262. "Annual Crops" = wellPanel(
  263. numericInput("cropcalcunit","Units",min = 0, value = 1),
  264. numericInput("cropcalcyield","Yield in AMD",min = 0, value = 1000),
  265. numericInput("cropcalccostunits","Units", min = 0, value = 1),
  266. numericInput("cropcalccostcost","Cost in AMD",min = 0, value = 1000)
  267. ),
  268. "Trees and Bushes" = wellPanel(
  269. numericInput("treecalcunit","Units", min = 0, value = 1),
  270. numericInput("treecalcyield","Yield (AMD)", min = 0, value = 1000),
  271. numericInput("treecalccostunit","Units",min = 0, value = 1),
  272. numericInput("treecalccostcost","Cost (AMD)", min = 0, value = 1000)
  273. ),
  274. "Livestock" = wellPanel(
  275. numericInput("livecalcunit","Units", min = 0, value = 1),
  276. numericInput("livecalcyield","Yield (AMD)",min = 0, value = 1000),
  277. numericInput("livecalccostunit","Units", min = 0, value = 1),
  278. numericInput("livecalccostcost","Cost (AMD)", min = 0, value = 1000)
  279. )
  280. )
  281. })
  282. ```
  283.  
  284. ### Help
  285.  
  286. You can get help from this page it provides an easy way to add text to accompany other widgets.
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement