i use app.
ui.R
shinyUI(
fluidPage(
actionButton("clear_ui", "clear_ui"),
actionButton("clear_date", "clear_date"),
uiOutput("date_ui"),
textOutput("date_text")
)
)
server.R
shinyServer(function(input, output) {
observeEvent(input$clear_ui,{
output$date_ui <- renderUI({NULL})
})
observeEvent(input$clear_date,{
output$date <- NULL
})
output$date_ui <- renderUI({
dateRangeInput("date", "a", start = "2001-01-01", end = "2010-12-31")
})
output$date_text <- renderText({
input$date
})
})
global.R
library(shiny)
library(DBI)
library(pool)
pool <- dbPool(
drv = RMySQL::MySQL(),
dbname = "shinydemo",
host = "shiny-demo.csa7qlmguqrf.us-east-1.rds.amazonaws.com",
username = "guest",
password = "guest"
)
By using "clear_ui", ui of daterangeInput can be deleted.
However, the contents of the output "date" will remain.
Is it possible to delete "date" data by using "clear_date"?
You need to replace output$date by output$date_text in:
observeEvent(input$clear_date,{
output$date <- NULL
})
Related
I would like to have a shiny app that, when run for the first time, displays a dataframe defined as a template, and then the user can upload a new one (in csv only) that replaces the current one. Therefore, in case the user imports a file of the wrong type, it produces a message instead. Here is my code, which results in an error, and I don't know why it doesn't work
library(shiny)
library(DT)
library(dplyr)
library(shiny)
ui <- fluidPage(
fileInput("upload", NULL, accept = c(".csv")),
tableOutput("head")
)
server <- function(input, output, session) {
rv <- reactiveValues(
dataframe = NULL
)
observe({
if(is.null(rv$dataframe)){
dataFrameFile <- reactive({
df <- data.frame(
x = seq(1:12),
y = rnorm(12))
rv$dataframe <- datatable(df)
return(rv$dataframe)
})
} else {
dataFrameFile <- reactive({
req(input$upload)
ext <- tools::file_ext(input$upload$name)
rv$dataframe <- switch(ext,
csv = read.csv(input$upload$datapath),
validate(" Please upload a .csv file")
)
})
}
})
output$head <- renderDT({
datatable(dataFrameFile())
})
}
shinyApp(ui, server)
A few corrections/simplifications:
Used DTOutput instead of tableOutput to correspond to renderDT
directly initialized rv
put the validate in the renderDT
library(shiny)
library(DT)
library(dplyr)
library(shiny)
ui <- fluidPage(
fileInput("upload", NULL, accept = c(".csv")),
DTOutput("head")
)
server <- function(input, output, session) {
rv <- reactiveValues(
dataframe = data.frame(
x = seq(1:12),
y = rnorm(12))
)
observe({
req(input$upload)
ext <- tools::file_ext(input$upload$name)
rv$dataframe <- switch(ext,
csv = read.csv(input$upload$datapath),
NULL)
})
output$head <- renderDT({
validate(need(!is.null(rv$dataframe)," Please upload a .csv file"))
rv$dataframe
})
}
shinyApp(ui, server)
I am trying to put this code in Shiny with dynamic dates and ticker selection, but I get the following error Operation not allowed without an active reactive context.
You tried to do something that can only be done from inside a reactive consumer.
library(quantmod)
library(PerformanceAnalytics)
dt <- "2017-2-1"
aapl <- getSymbols.yahoo("AAPL", from=dt, auto.assign = F)
aaplClose <- getSymbols.yahoo("AAPL", from=dt, auto.assign = F)[,6]
aaplRets <- na.omit(dailyReturn(aaplClose, type="log"))
Here is my shiny implementation
library(shiny)
library(quantmod)
library(PerformanceAnalytics)
#dt <- "2017-2-1"
ui <- fluidPage(
dateInput("dt", "Select a date:"),
textInput("tkr", "Enter a ticker symbol"),
plotOutput("myplot")
)
server <- function(input, output, session) {
aapl <- reactive ({
getSymbols.yahoo(input$tkr, from=input$dt, auto.assign = F)
})
aaplClose <- reactive ({
getSymbols.yahoo(input$tkr, from=input$dt, auto.assign = F)[,6]
})
aaplRets <- na.omit(dailyReturn(aaplClose(), type="log"))
output$myplot <- renderPlot(
{ chartSeries(aapl())}
)
}
shinyApp(ui, server)
Since you have a text input to select the ticker, the data should not be called apple, because it can be everything. Keeping everything in reactive contextes:
library(shiny)
library(quantmod)
library(PerformanceAnalytics)
ui <- fluidPage(
dateInput("dt", "Select a date:", value = "2017-2-1"),
textInput("tkr", "Enter a ticker symbol", value = "AAPL"),
plotOutput("myplot")
)
server <- function(input, output, session) {
data <- reactive({
getSymbols.yahoo(input$tkr, from = input$dt, auto.assign = F)
})
output$myplot <- renderPlot({
chartSeries(data())
})
}
shinyApp(ui, server)
Or with Alphabet:
I try to filter dataset based on dates chosen by user in datepicker. The code below reflects how it works in my real app. I have a reactive dataset created in main server. I need to pass filtered dataset all the way down to all modules in my app. Actually, user picks a date in mod_datepicker, then I pass his choice to main server server where I filter dataset and then pass it to mod_table. I found it difficult to pass reactive value pickedDates to main server. The error I got is:
Error in dates$pickedDates : couldn't find object 'dates'
Seems I can't pass reactive value pickedDates to main server. Is there any way to do make it possible?
Here is the reproducible example:
library(shiny)
library(shinyjs)
library(dplyr)
library(shinyWidgets)
moduleServer <- function(id, module) {
callModule(module, id)
}
# UI - datepicker #
mod_datepicker_UI <- function(id) {
ns <- NS(id)
tagList(
airDatepickerInput(
inputId = ns("datepicker"),
range = TRUE,
label = 'choose date range:',
separator = " | ",
value = c(Sys.Date(), Sys.Date()),
autoClose = TRUE,
dateFormat = 'yyyy-mm-dd'
))
}
# Server - datepicker #
mod_datepicker_server <- function(id){
moduleServer(id, function(input, output, session) {
return(
list(
pickedDates = reactive({input$datepicker})
)
)
})
}
# UI - table #
mod_table_UI <- function(id) {
ns <- NS(id)
tableOutput(ns("myTable"))
}
# Server - table #
mod_table_server <- function(id, df){
moduleServer(id, function(input, output, session) {
ns <- session$ns
output$myTable <- renderTable(df)
})
}
# App - main UI and Server #
ui <- fluidPage(
tagList(
mod_datepicker_UI("airDatepicker"),
mod_table_UI("table")
)
)
server <- function(input, output, session) {
Name <- c("Jon", "Bill", "Maria", "Ben", "Tina")
Date <- c('2021-07-12', '2021-07-13', '2021-07-14', '2021-07-15', '2021-07-16')
df <- data.frame(Name, Date)
df$Date <- as.Date(df$Date)
# dateFrom <- reactive({ as.Date('2021-07-12') }) # if you uncomment those 2 then it works
# dateTo <- reactive({ as.Date('2021-07-14') })
dateFrom <- reactive({ as.Date(dates$pickedDates[1]) })
dateTo <- reactive({ as.Date(dates$pickedDates[2]) })
# I use this reactive df in main server as to spread out data to the rest of modules in my app
finalDf <- reactive({
df %>%
filter(between(Date, dateFrom(), dateTo()))
})
dates <- mod_datepicker_server("airDatepicker")
mod_table_server("table", finalDf())
}
shinyApp(ui = ui, server = server)
As an example you can ucomment dateFrom and dateTo to see it works on hard coded reactive values.
i worked on data from SQL Server in R using RODBC and after getting my result i created ShinyApp to deploy my result But i want to get my data from my SQL query directly without exporting my result to Excel and then import it to shiny,How can i do that?
Test <- odbcDriverConnect("driver={SQL Server};server=localhost;database=Fakahany;trusted_connection=true")
Orders<- sqlQuery(Test,"
SELECT
WHWorkOrderHeaderId
, OtherLangDescription
FROM Warehouse.WHWorkOrderDetails
INNER JOIN Warehouse.WHWorkOrderHeader AS WHH
ON Warehouse.WHWorkOrderDetails.WHWorkOrderHeaderId = WHH.ID
INNER JOIN Warehouse.StockItems
ON Warehouse.WHWorkOrderDetails.StockItemId = Warehouse.StockItems.Id
WHERE Type = 'IO'
ORDER BY OtherLangDescription ASC")
#Creating the correlations
Orders$OtherLangDescription <- as.factor(Orders$OtherLangDescription)
orderList <- unique(Orders$OtherLangDescription)
ListId <- lapply(orderList, function(x) subset(Orders, OtherLangDescription == x)$WHWorkOrderHeaderId)
Initial_Tab <- lapply(ListId, function(x) subset(Orders, WHWorkOrderHeaderId %in% x)$OtherLangDescription)
Correlation_Tab <- mapply(function(Product, ID) table(Product)/length(ID),
Initial_Tab, ListId)
colnames(Correlation_Tab) <- orderList
cor_per<- round(Correlation_Tab*100,2)
DF<-data.frame(row=rownames(cor_per)[row(cor_per)], col=colnames(cor_per)[col(cor_per)], corr=c(cor_per))
and this is my app code:
#loading Packages
library(RODBC)
library(shiny)
library(rsconnect)
ui <- fluidPage(
titlePanel("Item Correlation"),
sidebarPanel(
selectInput("Item2","Select Item",choices= DF$FirstItem),
h6("Powerd By:"),
img(src='edrak.png',height='50px',width='110px')
# ,selectInput("Item","SelectItem",choices= DF$col)
),
mainPanel(
tableOutput("Itemcorr")
)
)
server <- function(input,output){
output$Itemcorr <- renderTable({
subset(DF, DF$FirstItem == input$Item2)
})
}
shinyApp(ui, server)
This should do what you want.
library(RODBCext)
library(shiny)
ui <- shinyUI(
pageWithSidebar(
headerPanel("Hide Side Bar example"),
sidebarPanel(
textInput("CATEGORY", "Enter CATEGORY below"),
submitButton(text="Submit")
),
mainPanel(
tabsetPanel(
tabPanel("Data", tableOutput("tbTable"))
)
)
)
)
server <- function(input, output, session)
{ # NOTE THE BRACE HERE
myData <- reactive({
req(input$CATEGORY)
#connect to database
dbhandle = odbcDriverConnect('driver={SQL Server};server=Server_Name;database=Database_Name;trusted_connection=true')
#build query
query = "SELECT * FROM [Your_Table] where [CATEGORY] = ?"
#store results
res <- sqlExecute(channel = dbhandle,
query = query,
data = list(input$CATEGORY),
fetch = TRUE,
stringsAsFactors = FALSE)
#close the connection
odbcClose(dbhandle)
#return results
res
})
output$tbTable <-
renderTable(myData())
} # AND NOTE THE CLOSING BRACE HERE
shinyApp(ui = ui, server = server)
You may want to consider this as well.
library(shiny)
library(RODBCext)
shinyApp(
ui =
shinyUI(
fluidPage(
uiOutput("select_category"),
tableOutput("display_data")
# plotOutput("plot_data")
)
),
# server needs the function; looks ok
server = shinyServer(function(input, output, session)
{
# A reactive object to get the query. This lets you use
# the data in multiple locations (plots, tables, etc) without
# having to perform the query in each output slot.
QueriedData <- reactive({
req(input$showDrop)
ch <- odbcDriverConnect("driver={SQL Server};server=Server_Name;database=DATABASE_NAME;trusted_connection=true")
showList <- sqlExecute(ch, "SELECT * FROM [Your_Table] WHERE Category = ?",
data = list(Category = input$showDrop),
fetch = TRUE,
stringsAsFactors = FALSE)
odbcClose(ch)
showList
})
# The select input control. These can be managed dynamically
# from the server, and then the control send back to the UI
# using `renderUI`
output$select_category <- renderUI({
ch <- odbcDriverConnect("driver={SQL Server};server=Server_Name;database=DATABASE_NAME;trusted_connection=true")
showList <- sqlExecute(ch, "Select Distinct Category From [Your_Table] Order by Category",
fetch = TRUE,
stringsAsFactors = FALSE)
odbcClose(ch)
selectInput(inputId = "showDrop",
label = "Select Asset",
showList$Category)
})
# Display the data in a table
output$display_data <- renderTable({
QueriedData()
})
# Display a plot
# output$plot_data <-
# renderPlot({
# plot(QueriedData()) # fill in the plot code you want to use.
# })
})
)
How i can store the data which i received from database as an object, that further (If needed) is going to be filtered with datatable (DT) and displayed using ggplot?
Here is code:
library(shiny)
library(ROracle)
library(DT)
ui <- shinyUI(navbarPage("Test",
tabPanel("Test",
sidebarLayout(
sidebarPanel(
textInput("drv", "Database Driver", value="Oracle"),
textInput("user", "User ID"),
passwordInput("passwd", "Password"),
actionButton("connectDB", "Connect to DB")) ,
mainPanel(
textOutput("test"),
wellPanel(
uiOutput("tabnames_ui"),
uiOutput("columnnames_ui"),
actionButton("button1", "Select")),
plotOutput("plot"),
dataTableOutput("tabelle")
))
)
))
server <- shinyServer(function(input, output, session) {
con=reactiveValues(cc=NULL)
observeEvent(input$connectDB,{
if(input$drv != "Oracle"){
con$cc="Only 'Oracle' implemented currently"
}else{
drv <- dbDriver("Oracle")
con$cc<- dbConnect(drv,"xxx/x",username=input$user,password=input$passwd)
}
})
observe({
if(!is.null(con$cc)& is(con$cc,"OraConnection")){ # check if connected
output$test <- renderText({
"connection success"
})
tableList <-reactive({
dbListTables(con$cc,schema="K")
})
columnList <-reactive({
dbListFields(con$cc, name=input$tabnames, schema = "K")
})
output$tabnames_ui=renderUI({selectInput("tabnames",label = "Tabelle:", choices = tableList(), selected="xy")})
output$columnnames_ui=renderUI({
selectInput("columnname", label = "Spalten:", choices = columnList(), multiple=TRUE, selected=
if(input$tabnames== "xy"){
c("DATI_CREATE","BLOCKNR","ORDNR")}
else{NULL})
})
d <- eventReactive(input$button1, { input$tabnames })
sqlOutput <- reactive({
sqlInput <- paste("select",paste(input$columnname, collapse = ","), "from K.",d(), "where dati_create between to_date('02.01.2016','dd.mm.yyyy') and to_date('07.01.2016','dd.mm.yyyy')")
rs <- dbGetQuery(con$cc, sqlInput)
})
output$tabelle <- DT::renderDataTable({
input$button1
datatable(isolate(sqlOutput()), rownames=FALSE, filter="top", options=list(pageLength=10))})
output$plot <- renderPlot({
filtered_data <- input$tabelle_rows_all
data_filt <- sqlOutput()[filtered_data,] # this row is responsible for empty plot. How i can store the sqlOutput() object so i can further manipulate it?
ggplot(data_filt, aes(x=ORDNR,y=BLOCKNR)) + geom_line()
})
}else if (!is.null(con$cc) ){
output$test <- renderText({
con$cc
})
}
})
session$onSessionEnded(function() {
observe({
if(!is.null(con$cc)& is(con$cc,"OraConnection")){# check if connected
print(paste0("disconnect ",dbDisconnect(con$cc)))}
})
})
})
shinyApp(ui=ui, server=server)
Thanks for any help!
[SOLVED]
Problem was with rownames=FALSE
so for the datatable, it should look like this:
output$tabelle <- DT::renderDataTable({
input$button1
datatable(isolate(sqlOutput()), rownames=TRUE, filter="top", options=list(pageLength=10))})
Cheers