hi..how to implement onchange script function in R..
please refer any sites regarding to script..
thank you:)
minimalistic exaple:
library(shiny)
ui = shinyUI(fluidPage(titlePanel("JS onchange min example"),
sidebarLayout(
sidebarPanel(tags$p("Enter color of text"),
tags$input(id = 'textId', type = 'text', onchange = "$('h3').css('color',this.value)")
),
mainPanel(
tags$h3('sometext')
))
));srv = shinyServer(function(input, output) {})
runApp(shinyApp(ui,srv),launch.browser = TRUE)
read more about 'change' and other events:
if you have concrete challenge you are facing then please provide more details so that we can help.
Kind regards,
Peter
I have huge data set which consists of major & minor groups. for (eg: GROCERY FOOD is a major group and it has many sub-groups like OIL,FLOUR and etc) now i want to know, if i click on Grocery food, the sub-groups related to it should be displayed automatically in another drop-down list .
here with i have attached my output window.
i see, can you not use the updateSelectInput or updateSelectizeInput?
observeEvent(input$majorgroup,{
choices = unique(myDataTable[myDataTable$MAJOR_GROUP==input$majorgroup,][['MINOR_GROUP']])
updateSelectInput(session=session, inputId = 'minorgroup', choices = choices)
#in case you are using selectizeInput then updateSelectizeInput
}
i will try this....thank you so much...
observeEvent goes to server function therefore
server <- shinyServer(function(input,output,session){
observeEvent(...,{
...
})
...
})
additionally in your line 35 change the following to prevent duplicate values
new$MAJOR
to
unique(new$MAJOR)
also i can see you are using multiple=FALSE argument (default) therefore in order to work with "All"
observeEvent(input$majorgroup,{
choices = c("All",unique(new[new$MAJOR==input$majorgroup | input$majorgroup=="All",][['MINOR']]))
updateSelectInput(session=session, inputId = 'MINOR', choices = choices)
}
its working....thank u so much 
sir one more problem...while clicking on minor choices its not rendering the table its automatically redirecting to the choice "all"
from the example (screen) you provided before i cannot see the reason why.
i have noticed i made a mistake in the observeEvent solution i provided.
should end with ")" therefore
in case you placed the closed bracket somewhere later in the code after input$MINOR then this may trigger the observer. I have experienced this before that observeEvent was reactive to expr part as well.
If you can provide bigger chunk of your code i will have a look at the problem.
rgds,
Peter
thanks...my full code is here:
library(shiny)
library(shinydashboard)
library(RMySQL)
library(plotly)
library(DT)
conn <- dbConnect(
drv = RMySQL::MySQL(),
host ="localhost",
dbname="data",
username="root",
password="")
new<-dbGetQuery(conn,"SELECT DISTINCT VBRNCH AS BRANCH,VMAJGR AS MAJOR,VMINGR AS MINOR FROM invcpf GROUP BY VBRNCH,VMAJGR")
ui<-dashboardPage(
skin="purple",
dashboardHeader(title = "PKC ADVISORY"),
dashboardSidebar(
sidebarMenu(
menuItem("DASHBOARD", icon=icon("dashboard"),tabName = "dash"),
sidebarMenu(
menuItem("REPORTS",
sidebarMenu(
menuSubItem("SALES",tabName = "sales")
))
)
)
),
dashboardBody(
tabItems(
tabItem("dash",
selectInput("majorgroup",
"SELECT major",
c("All",
unique(new$MAJOR))),
selectInput("MINOR",
"SELECT MINOR",""),
dataTableOutput("table")
)))
)
server <- shinyServer(function(input,output,session){
output$table<-DT::renderDataTable(DT::datatable({
observeEvent(input$majorgroup,{
choices = c("All",unique(new[new$MAJOR==input$majorgroup | input$majorgroup=="All",][['MINOR']]))
updateSelectInput(session=session, inputId = 'MINOR', choices = choices)
})
data<-dbGetQuery(conn,"SELECT DISTINCT VBRNCH AS BRANCH,VMAJGR AS MAJOR_GROUP,VMINGR AS MINOR_GROUP,VNETIV AS SALES FROM invcpf GROUP BY VBRNCH,VMAJGR,VMINGR")
if (input$majorgroup != "All") {
data <- data[data$MAJOR_GROUP == input$majorgroup,]
}
if(input$MINOR !="All"){
data<-data[data$MINOR_GROUP == input$MINOR,]
}
data
}))
})
shinyApp(ui=ui,server=server)
also one more problem...some of the minor groups are missing when i select any major
this will be a bit longer post sorry:
here's what happens:
output$table<-DT::renderDataTable(DT::datatable({
creates reactive element in output list, it will be triggered by any reactive expression inside unless it is wrapped in isolate()
observeEvent(input$majorgroup,{
choices = c("All",unique(new[new$MAJOR==input$majorgroup | input$majorgroup=="All",][['MINOR']]))
updateSelectInput(session=session, inputId = 'MINOR', choices = choices)
})
observer inside reactive function (i dont recommend using this structure at all), the idea of observer is that it's trigger is controlled by variable value change.
in your case you want to trigger updating minorgroup choices when majorgroup is changed, therefore observe majorgroup to change minorgroup.
what however happens is that if minorgroup is changed it triggers whole renderDataTable({}) because that is reactive to input$MINOR (because you have input$MINOR!="All" condition and you filter table on input$MINOR.
since you observer is inside renderDataTable it gets (now i am not sure about exact process) either initialized again each time or triggered which in any case leads to updating choices in your MINOR selectInput.
updating choices also updates what is selected and in case of selectInput(...,multiple=FALSE) the auto-selected is the first of the choices which is "All" in this case.
data<-dbGetQuery(conn,"SELECT DISTINCT VBRNCH AS BRANCH,VMAJGR AS MAJOR_GROUP,VMINGR AS MINOR_GROUP,VNETIV AS SALES FROM invcpf GROUP BY VBRNCH,VMAJGR,VMINGR")
not sure you need to fetch whole dataset each time you display table on website. is your table in DB updated that often and users need live access?
i have build whole business insights portal for company and we update DB with sales overnight, users would rarely need to see what has been sold a minute ago.
moving your DB query ouside renderDataTable will make your app faster since it doesnt need to fetch data with each change of inputs
i'd therefore suggest moving query to serverFunction or even above that, or alternatively build parametrized query for givent filters only.
on another subject, did you want to summarize sales?
if so than:
SELECT DISTINCT here as this will deduplicate data, therefore if you two items sold in same branch, same major, same minor and same price it will be counted only once
using GROUP BY all non sales columns will ensure uniqueness of each row
not to mention SELECT DISTINCT will run deduplication on already deduplicated table which takes some time (unless the query compiler knows this will be unique already and skips that)
so query probably should look like:
SELECT VBRNCH AS BRANCH,VMAJGR AS MAJOR_GROUP,VMINGR AS MINOR_GROUP,sum(VNETIV) AS SALES FROM invcpf GROUP BY VBRNCH,VMAJGR,VMINGR
if (input$majorgroup != "All") {
data <- data[data$MAJOR_GROUP == input$majorgroup,]
}
if(input$MINOR !="All"){
data<-data[data$MINOR_GROUP == input$MINOR,]
}
data
}))
in here you split data filtering into two parts, if ... then filter data on majorgroup if ... then filter data on minorgroup.
as shiny is multiuser environment where saving seconds in execution time may make tangible difference in overall performance and user experience.
(we had external company develop module that took 40s from time user clicked submit till they saw the resulting table, with code optimization it was cut to 4s, but they had very bad programming practices)
reason why i mention this, imagine your user selected majorgroup and minorgroup as well, what R does with each filtering is that it has to allocate new memory for whole filtered table, copy subset there and delete (free)
allocated memory for old data, then repeat this again for minorgroup filtering, allocating memory is expensive operation with big datasets. This has been partially mitigated with data.table package where only as much as a single
column is copied.
in many cases the bottleneck of shiny performance issues is allocating new memory and copying data there, you can read more on this subject if you google copy-on-write.
this is however completely different topic and bit more complicated so we can revisit if you experience performance issues.
suggested change:
data = data[
if(input$majorgroup == "All"){!vector(mode='logical',length=nrow(data))}else{MAJOR_GROUP == input$majorgroup} &
if(input$MINOR == "All"){!vector(mode='logical',length=nrow(data))}else{MAJOR_GROUP == input$MINOR}
]
i have rewritten the code with sample table, please let me know if this is a workable solution for you:
library(shiny)
library(shinydashboard)
# library(RMySQL)
# library(plotly)
library(DT)
library(RSQLite)
library(data.table)
# conn <- dbConnect(
# drv = RMySQL::MySQL(),
# host ="localhost",
# dbname="data",
# username="root",
# password="")
conn = dbConnect(drv = SQLite(),dbname=":memory:");set.seed(314159)
sampleData = data.table::data.table(VBRNCH = sample(x = c(2L:5L,10L,14L,20L),size = 100000L,replace = TRUE),VMAJGR = sample(x = c(1:9),size = 100000L,replace = TRUE),
VNETIV = round(runif(n = 100000L)*100,digits = 2L))[,VMINGR:=sample(x=c(100L,1000L,1100L),size = 100000L,replace = TRUE)*VMAJGR+sample(x = 1:5,size = 100000L,replace = TRUE)]
dbWriteTable(conn = conn,name = 'invcpf', value = sampleData);sampleData=NULL;
new<-dbGetQuery(conn,"SELECT DISTINCT VBRNCH AS BRANCH,VMAJGR AS MAJOR,VMINGR AS MINOR FROM invcpf GROUP BY VBRNCH,VMAJGR")
ui<-dashboardPage( skin="purple",
dashboardHeader(title = "PKC ADVISORY"),
dashboardSidebar(
sidebarMenu(
menuItem("DASHBOARD", icon=icon("dashboard"),tabName = "dash"),
sidebarMenu(
menuItem("REPORTS",
sidebarMenu(
menuSubItem("SALES",tabName = "sales")
))
)
)
),
dashboardBody(
tabItems(
tabItem("dash",
selectInput("majorgroup","SELECT major", c("All"="",unique(new$MAJOR))),
selectInput("MINOR","SELECT MINOR",""),
dataTableOutput("table")
)))
)
server <- shinyServer(function(input,output,session){
observeEvent(input$majorgroup,{
choices = unique(new[new$MAJOR==input$majorgroup | input$majorgroup=="",][['MINOR']]);updateSelectInput(session=session, inputId = 'MINOR', choices = c("All"="",choices[order(choices)]))
})
output$table<-DT::renderDataTable({
if(input$majorgroup == "" & input$MINOR == "")
query = "SELECT VBRNCH AS BRANCH,VMAJGR AS MAJOR_GROUP,VMINGR AS MINOR_GROUP,sum(VNETIV) AS SALES FROM invcpf GROUP BY VBRNCH,VMAJGR,VMINGR"
else{
query = paste0(
"SELECT VBRNCH AS BRANCH,VMAJGR AS MAJOR_GROUP,VMINGR AS MINOR_GROUP,sum(VNETIV) AS SALES FROM invcpf where ",
paste(c(if(input$majorgroup == ""){NULL}else{sprintf(" VMAJGR = %d ",as.integer(input$majorgroup))},if(input$MINOR == ""){NULL}else{sprintf(" VMINGR = %d ",as.integer(input$MINOR))}),collapse = 'and'),
"GROUP BY VBRNCH,VMAJGR,VMINGR"
)
}
data<-as.data.table(dbGetQuery(conn,query))
data = data[
(if(input$majorgroup == ""){!vector(mode='logical',length=nrow(data))}else{MAJOR_GROUP == input$majorgroup}) &
(if(input$MINOR == ""){!vector(mode='logical',length=nrow(data))}else{MINOR_GROUP == input$MINOR})
]
expr = DT::datatable(data = data, rownames = FALSE, class = "cell-border compact hover nowrap") %>%
formatCurrency(columns = 'SALES',digits = 2L,currency = '$ ')
})
})
shinyApp(ui=ui,server=server)
thanks...Its working sir, but some of the minor groups are missing in (minor) drilldown...but the table displaying all the minor groups related to major which i have selected...
