r - How to use function with passing function has reactive as input in shiny -

-

i have little problem. have build package called d3k can used across different dashboard. 1 of function follows:

conditionalrendervaluebox <- function(value, title, red_limit, yellow_limit){       rendervaluebox(    valuebox(value, title,       color = if(class(value)=="character" | is.na(value)){         "blue"       }else if(value>red_limit ){         "red"       }else if(value>yellow_limit){         "yellow"       }else{         "green"       }     )) }

now trying pass value parameter in function, parameter reactive value.

server.r

library(lubridate) # library(googlevis) # library(readr) library(shinyjs) library(ggplot2) library(plotly) library(d3k) library(dplyr) server <- function(input, output, session) {     v1 = reactive({       input$v1    })     f <-  reactive({       if(is.na(v1())){           "wai"        }else{            runif(1, 1, 10)        }        }) output$t <- conditionalrendervaluebox(f(), "possible value", 15, 10)  }

ui.r

library(shinydashboard) library(shiny) library(shinyjs) library(plotly)  ui <- dashboardpage(    dashboardheader(title = "dashboard")   ,skin = 'yellow'     ,dashboardsidebar(       tags$head(       tags$style(html("                       .sidebar { height: 90vh; overflow-y: auto; }                       " )       )     ),        sidebarmenu(            menuitem("r", tabname = "r", icon = icon("cog"))           , selectinput("v1", label = h3("select box"),  choices = list( 1,  11, 15),  selected = 1),         )      )      ,dashboardbody(        tabitems(           tabitem(              tabname = "r"              , br()              , fluidrow(                   valueboxoutput("t")                 )    ) ) ) )

i not able see value box in shiny dashboard.

however, if use following code in plase of output$t in server , works 

output$t <- rendervaluebox(    valuebox(f(), "title",           color = if(class(f())=="character" | is.na(f())){             "blue"           }else if(f()>red_limit ){             "red"           }else if(f()>yellow_limit){             "yellow"           }else{             "green"           }         ))

then able see result expected

i find runs if define conditionalrendervaluebox in script so:

library(lubridate) # library(googlevis) # library(readr) library(shinyjs) library(ggplot2) library(plotly) # library(d3k) don't have access package library(dplyr) library(shinydashboard) library(shiny) library(shinyjs) library(plotly)  conditionalrendervaluebox <- function(value, title, red_limit, yellow_limit){   rendervaluebox(    valuebox(value, title,                               color = if(class(value)=="character" | is.na(value)){                                 "blue"                               }else if(value>red_limit ){                                 "red"                               }else if(value>yellow_limit){                                 "yellow"                               }else{                                 "green"                               } }  server <- function(input, output, session) {    v1 = reactive({     input$v1   })   f <-  reactive({     if(is.na(v1())){       "wai"     }else{       runif(1, 1, 10)     }   })   output$t <- conditionalrendervaluebox(f(), "possible value", 15, 10)     )) }  ui <- dashboardpage(   dashboardheader(title = "dashboard")   ,skin = 'yellow'   ,dashboardsidebar(     tags$head(       tags$style(html("                       .sidebar { height: 90vh; overflow-y: auto; }                       " )       )     ),     sidebarmenu(       menuitem("r", tabname = "r", icon = icon("cog"))       , selectinput("v1", label = h3("select box"),                      choices = list( 1,  11, 15),                      selected = 1)           )       )   ,dashboardbody(     tabitems(       tabitem(         tabname = "r"         , br()         , fluidrow(           valueboxoutput("t")         )        )     )   ) )  runapp(shinyapp(server=server,ui=ui))

i guessing problem how package exports function, it's hard me know without seeing code.

hope helps.

edit: hey don't know d3k package , if you've gotten work, far can tell don't want write functions wrap render* shiny functions. app below won't work:

myfunc <- function(x) {   rendertable({     head(x)   }) }  shinyapp(   ui=fluidpage(     selectinput("select","choose dataset",c("mtcars","iris")),     tableoutput("table")     ),   server=function(input,output) {      dataset <- reactive({       get(input$select)     })      output$table <- myfunc(dataset())    })

the function runs once on start-up , renders initial table, never changes after because myfunc doesn't understand reactivity render* functions do.

i think function should wrap valuebox element , feed function rendervaluebox so:

library(lubridate) # library(googlevis) # library(readr) library(shinyjs) library(ggplot2) library(plotly) # library(d3k) don't have access package library(dplyr) library(shinydashboard) library(shiny) library(shinyjs) library(plotly)  conditionalrendervaluebox <- function(value, title, red_limit, yellow_limit){    #rendervaluebox(      valuebox(value, title,                           color = if(class(value)=="character" | is.na(value)){                                 "blue"                               }else if(value>red_limit ){                                 "red"                               }else if(value>yellow_limit){                                 "yellow"                               }else{                                 "green"                               }   )   #) }  server <- function(input, output, session) {    v1 = reactive({     input$v1   })   f <-  reactive({     v1 <- v1()     print("hey")     if(is.na(v1)){       "wai"     }else{       runif(1, 1, 10)     }   })   observe({   output$t <- rendervaluebox(conditionalrendervaluebox(f(), "possible value", 15, 10))   })  }  ui <- dashboardpage(   dashboardheader(title = "dashboard")   ,skin = 'yellow'   ,dashboardsidebar(     tags$head(       tags$style(html("                       .sidebar { height: 90vh; overflow-y: auto; }                       " )       )       ),     sidebarmenu(       menuitem("r", tabname = "r", icon = icon("cog"))       , selectinput("v1", label = h3("select box"),                      choices = list( 1,  11, 15),                      selected = 1)           )           )   ,dashboardbody(     tabitems(       tabitem(         tabname = "r"         , br()         , fluidrow(           valueboxoutput("t")         )        )     )   ) )  runapp(shinyapp(server=server,ui=ui))

Comments

Post a Comment

Popular posts from this blog

javascript - Slick Slider width recalculation -

-
i'm trying add slide in panel on slick container css. carousel works except new width not being calculated when space has been added. recalibrate once advance next slide i'd happen each time panel opened or closed. i've tried adding both margin , padding, neither makes difference. ideas? https://jsfiddle.net/mhigley/dpf7mlpl/ html: <button type="button" id="button"><i class="fa fa-arrow-right"></i></button> <aside> <h2>slide in panel</h2> <ol> <li>list item</li> <li>list item</li> <li>list item</li> <li>list item</li> <li>list item</li> </ol> </aside> <main role="main"> <div class="sections"> <section> <article> <h2>first slide</h2> <p>lorem ipsum d...
Read more

jsf - PrimeFaces Datatable - What is f:facet actually doing? -

-
looking through primefaces code in app noticed following line: <f:facet name="header">#{trainsearch.traincount} trains</f:facet> it looks overriding header, makes sense, can explain me in little more detail? what happening line of code? complete code listed below: <p:datatable id = "results" value = "#{trainsearch.trains}" var = "train" rendered="#{not empty trainsearch.trains}" styleclass = "train-search-table horizontal-border"> <f:facet name="header">#{trainsearch.traincount} trains</f:facet> <p:column headertext = "train id"> <p:panelgrid columns="1" styleclass = "train-id-grid" layout = "grid"> <h:outputtext styleclass = "train-id-label" value="#{train.traini}"/> <h:outputtex...
Read more

angular2 services - Angular 2 RC 4 Http post not firing -

-
i trying fire post request app , it's not working, tried multiple ways. don't see request being fired under network tab in chrome. not sure problem is, appreciated. import { injectable } '@angular/core'; import { http, headers } '@angular/http'; @injectable() export class userservice{ private _url="users"; constructor(private _http: http){ } checkifusernameexists(username){ return this._http.get(this._url+"/"+username) .map(response => response.json()) } createuser(user){ let headers = new headers(); headers.append('content-type', 'application/json') console.log(json.stringify(user)); return this._http.post(this._url, json.stringify(user),{headers: headers}) .map(response => response.json()) } } first need capture error , solve error: this._http.post(this._url, json.stringify(user),{headers: headers}) .subscribe( ...
Read more