I try to pull data from Google Analytics with API-R. There are my two files for running my shiny app here:
ui.R
shinyUI(pageWithSidebar(
headerPanel("My Shiny APP"),
sidebarPanel(
dateRangeInput("dateRange",
label = "Select date range:",
start = Sys.Date() - 7, end = Sys.Date()-6)),
mainPanel(
fluidPage(
fluidRow(
column(12,
dataTableOutput("table")
)
)
))))
server.R
ga_token <- authorize(client.id = "XXXXXXXXX.apps.googleusercontent.com",
client.secret = "XXXXXXXXXXX",
cache = "token")
shinyServer(function(input, output){
getDataFromGA <- reactive({
ga.data <- get_ga(profileId = "ga:xxxxxxx",
start.date =input$dateRange[1], end.date = input$dateRange[2],
metrics = c("ga:sessions","ga:bounceRate"), dimensions = "ga:userType",
samplingLevel = "HIGHER_PRECISION", start.index = NULL,
max.results = 10000, include.empty.rows = NULL, fetch.by = NULL, ga_token)
return(ga.data)
})
output$table = renderDataTable({
ga.data <- getDataFromGA()
if (is.null(ga.data)) return(NULL)
})
})
If I put a reactive expression at output$table, I have the same problem (the output table doesn't appear, and R doesn't print me any error message).
Libraries I load: devtools, RGA, shiny.
Instead of simply using reactive, you can try reactiveValues and observeEvent.
Your code may look something like:
values <- reactiveValues(start.date = NULL, end.date = NULL, ga.data = NULL)
observeEvent(input$dateRange, {
values$start.date <- input$dateRange[1]
values$end.date <- input$dateRange[2]
values$ga.data <- get_ga(...) })
You can access the google analytics object as: values$ga.data
Related
When building out a shiny application and testing management of reactive components I came across this oddity when trying to dynamically fill textOutputs based on a selection in another table. I am unable to show the correct value in the textOutput but the Shiny Logger would seem to indicate my value is correct.
UI ouput is the row number.
Shinylogger output is the accountID
POC developed from these resources:
Subset a Column of a dataframe stored as a reactive expression eventReactive
Returning a dataframe in a reactive function in R Shiny Dashboard
POC code below.
Looking to reconcile why the shinylogger value is different from the textOutput value in the UI.
library(shiny)
library(shinyEventLogger)
library(bs4Dash)
library(dplyr)
ui <- fluidPage(
fluidRow(
column(
width = 12,
div(
bs4Dash::bs4Card(
id = "searchtableCard",
title = "Search Results",
elevation = 3,
width = 12,
closable = FALSE,
DT::dataTableOutput("searchTable")
)
)
)
),
fluidRow(
textOutput("accountid")
)
)
server <- function(input, output){
shinyEventLogger::set_logging(
r_console = TRUE,
file = TRUE,
js_console = TRUE)
shinyEventLogger::set_logging_session()
searchresults <- data.frame(
accountID = c("12345", "54321"),
lastname = c("McDingus", "McKraken"),
phone1 = c("555-123-5432", "555-000-5432")
)
applications <- data.frame(
accountID = c("12345", "54321"),
firstname = c("Alison", "Angus"),
lastname = c("McDingus", "McKraken"),
veh_make = c("Dodge", "Honda"),
veh_model = c("Charger", "Civic")
)
searchreactive <- shiny::reactive({searchresults})
# Search Table Output
output$searchTable = DT::renderDataTable({
searchreactive()
},
extensions = "Responsive", filter = "bottom", selection = 'single'
)
shiny::observeEvent(input$searchTable_rows_selected, {
s = input$searchTable_rows_selected
selRow <- searchreactive()[s,]
id = selRow[[1]]
app_active <- applications %>%
filter(accountID == id)
shinyEventLogger::log_value(app_active$accountID)
output$accountid <- shiny::renderText(app_active$accountID)
})
}
# Run the application
shinyApp(ui = ui, server = server)
I have created a shiny app to display the plot of stock price of a chosen Company.I want to displaythe prices in a tabular form aswell,which i am unable to do.On trying an error message states cannot coerce class ‘c("reactiveExpr", "reactive")’ to a data.frame.
The code is as follows:
# Load packages ----
library(shiny)
library(quantmod)
#edited the code.this can be run directly
# User interface ----
ui <- fluidPage(
titlePanel("stockVis"),
sidebarLayout(
sidebarPanel(
helpText("Select a stock to examine.
Information will be collected from Yahoo finance."),
textInput("symb", "Symbol", "SPY"),
dateRangeInput("dates",
"Date range",
start = "2013-01-01",
end = as.character(Sys.Date())),
br(),
br(),
checkboxInput("log", "Plot y axis on log scale",
value = FALSE)
#checkboxInput("adjust",
#"Adjust prices for inflation", value = FALSE)
),
mainPanel(plotOutput("plot"), tableOutput("view")))
)
# Server logic
server <- function(input, output) {
dataInput <- reactive({
getSymbols(input$symb, src = "yahoo",
from = input$dates[1],
to = input$dates[2],
auto.assign = FALSE)
})
output$plot <- renderPlot({
chartSeries(dataInput(), theme = chartTheme("white"),
type = "line", log.scale = input$log, TA = NULL)
})
output$view <- renderTable({(dataInput )
}, include.rownames = TRUE)
}
# Run the app
shinyApp(ui, server)
As the error says its a reactive function so you have to use it as such: dataInput() and not dataInput
output$view <- renderTable({
dataInput()
}, include.rownames = TRUE)
I want to write the stock price values to an excel/csv file but I am unable to do so. The following error code is displayed: Operation not allowed without an active reactive context. (You tried to do something that can only be done from inside a reactive expression or observer.) Where when I use the reactive data(dataInput ) then the error message reads as "cannot coerce class ‘c("reactiveExpr", "reactive")’ to a data.frame
Code is enclosed here:
Load packages ----
library(shiny)
library(quantmod)
#edited the code.this can be run directly
# User interface ----
ui <- fluidPage(
titlePanel("stockVis"),
sidebarLayout(
sidebarPanel(
helpText("Select a stock to examine.
Information will be collected from Yahoo finance."),
textInput("symb", "Symbol", "SPY"),
dateRangeInput("dates",
"Date range",
start = "2013-01-01",
end = as.character(Sys.Date())),
br(),
br(),
checkboxInput("log", "Plot y axis on log scale",
value = FALSE)
#checkboxInput("adjust",
#"Adjust prices for inflation", value = FALSE)
),
mainPanel(plotOutput("plot"), tableOutput("view")))
)
# Server logic
server <- function(input, output) {
dataInput <- reactive({
getSymbols(input$symb, src = "yahoo",
from = input$dates[1],
to = input$dates[2],
auto.assign = FALSE)
}) Blockquote
output$plot <- renderPlot({
chartSeries(dataInput(), theme = chartTheme("white"),
type = "line", log.scale = input$log, TA = NULL)
})
output$view <- renderTable({(dataInput() )
}, include.rownames = TRUE)
#trying to export the data
write.csv(dataInput(),row.names = TRUE)
}`enter code here`
# Run the app
shinyApp(ui, server)
In the reactive context, it's trying to execute the code immediately upon running the Shiny app and as soon as the stock symbol starts changing. To permit the file to write only when the user is ready, change 'reactive' to 'observe event'. A 'run' button has been added to make it work. Copy and paste the code below.
By the way, because the 'file=' is omitted in the 'write.csv' command, which scrolls the csv file to the console.
This is a nice utility which makes it easy to download stock prices to a csv file.
library(shiny)
library(quantmod)
#edited the code.this can be run directly
# User interface ----
ui <- fluidPage(
titlePanel("stockVis"),
sidebarLayout(
sidebarPanel(
helpText("Select a stock to examine.
Information will be collected from Yahoo finance."),
textInput("symb", "Symbol", "SPY"),
dateRangeInput("dates",
"Date range",
start = "2013-01-01",
end = as.character(Sys.Date())),
br(),
br(),
checkboxInput("log", "Plot y axis on log scale",
value = FALSE),
#checkboxInput("adjust",
#"Adjust prices for inflation", value = FALSE),
actionButton(inputId = "run",label="Run"),
),
mainPanel(plotOutput("plot"), tableOutput("view")))
)
# Server logic
server <- function(input, output) {
dataInput <- function() {
getSymbols(input$symb, src = "yahoo",
from = input$dates[1],
to = input$dates[2],
auto.assign = FALSE)
}
observeEvent (input$run, {
output$plot <- renderPlot({
chartSeries(dataInput(), theme = chartTheme("white"),
type = "line", log.scale = input$log, TA = NULL)
})
output$view <- renderTable({(dataInput() )
}, include.rownames = TRUE)
#trying to export the data
write.csv(dataInput(),row.names = TRUE)
})
}
# Run the app
shinyApp(ui, server)
I'm trying to set up a ShinyApp which can access to a PostGreSQL/PostGIS database and perform reactive queries according to user inputs via selectInput widget.
I succeed to perform it with single inputs following this example (https://www.cybertec-postgresql.com/en/visualizing-data-in-postgresql-with-r-shiny/). My working code (sorry for non reprex example, but I cannont provide my database login for security purpose).
pool <- dbPool(drv = dbDriver("PostgreSQL", max.con = 100), user = "user", password = "pswd", host = "000.000.00.000", port = 5432, dbname = "db_name", idleTimeout = 3600000)
typology <- dbGetQuery(pool, "SELECT type FROM table GROUP BY type")
all_typo <- sort(unique(typology$type))
area_agripag <- dbGetQuery(pool, "SELECT area_name FROM table GROUP BY area_name")
all_area <- sort(unique(area_agripag$area_name))
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
selectInput(
inputId = "area",
label = "Select a district",
choices = all_area,
selected = 'district_1',
multiple = FALSE,
selectize = FALSE
),
selectInput(
inputId = "typo",
label = "Select a type",
choices = all_typo,
selected = 'type1',
multiple = FALSE,
selectize = FALSE
)
),
mainPanel(
tabsetPanel(
tabPanel("graph", plotOutput("plot")),
tabPanel("Table", dataTableOutput("table"))
)
)
)
)
server <- function(input, output, session) {
selectedData <- reactive({
req(input$area)
req(input$typo)
query <- sqlInterpolate(ANSI(),
"SELECT year, SUM(surface)
FROM table
WHERE area_name = ?area_name
AND type = ?type
GROUP BY year;",
area_name = input$area, type = input$typo)
outp <- as.data.frame(dbGetQuery(pool, query))
})
output$table <- DT::renderDataTable({
DT::datatable( data = selectedData(),
options = list(pageLength = 14),
rownames = FALSE)
})
output$plot <- renderPlot({
ggplot( data = selectedData(), aes(x = year, y = sum)) + geom_point()
})
}
shinyApp(ui = ui, server = server)
What I want to do is editing the reactive query in the server part in order to allow multiple selectInput. I should add IN operator instead of = in the sql query :
selectedData <- reactive({
req(input$area)
req(input$typo)
query <- sqlInterpolate(ANSI(),
"SELECT year, SUM(surface)
FROM table
WHERE area_name IN (?area_names)
AND type IN (?types)
GROUP BY year;",
area_names = input$area, types = input$typo)
outp <- as.data.frame(dbGetQuery(pool, query))
})
Next I know I should format the area_names / types vector returned by a multiple selectInput with some automatic regular expression. I want to wrap each elements of the vector with '', in order to accord with the SQL syntax.
For example, I want to transfrom the following multiple input$area vector :
area1 area2 area3
to
'area1', 'area2', 'area3'
In order to store it in the area_names sqlInterpolate argument.
Anyone has an idea how to perform this? Thanks to all contributions.
I print the output as textOutput, but i guess you can pick up the idea for whatever you want for :-)
#
# This is a Shiny web application. You can run the application by clicking
# the 'Run App' button above.
#
# Find out more about building applications with Shiny here:
#
# http://shiny.rstudio.com/
#
library(shiny)
# Define UI for application that draws a histogram
ui <- fluidPage(
# Application title
titlePanel("Old Faithful Geyser Data"),
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
sliderInput("bins",
"Number of bins:",
min = 1,
max = 50,
value = 30),
selectizeInput("mult", label = "Chooose", choices = c("area1", "area2", "area3"), selected = "area1", multiple = TRUE)
),
# Show a plot of the generated distribution
mainPanel(
textOutput("text")
)
)
)
# Define server logic required to draw a histogram
server <- function(input, output) {
output$text <- renderText({
output <- ""
print(length(input$mult))
for(i in 1:length(input$mult)) {
if(i == length(input$mult)) {
output <- paste0(output, "'", input$mult[[i]], "'")
} else {
output <- paste0(output, "'", input$mult[[i]], "', ")
}
}
output
})
}
# Run the application
shinyApp(ui = ui, server = server)
Explanation: The input$multis a vector which lengths depends on how many inputs are selected. I initialize an empty output and start the loop.
paste0 will convert the input to a string and add a comma, except for the last iteration, where we do not want a comma. The double brackets extract the value by indexing. Hope this gets clear below:
x <- c(3,5,7)
paste0(x[[1]], " and ", x[[2]], " and ", x[[3]])
1] "3 and 5 and 7"
The [[i]] will change its value every iteration. Check out this to get a feeling for it.
https://www.r-bloggers.com/how-to-write-the-first-for-loop-in-r/
At the end, we just return the final string :-)
So after 2 days I figured out the problem. The mistake was sticking to sqlInterpolate for creating the SQL query. Using some renderPrint function to visualize the generated query, I noticed that some inopportune double quote was showing up in my query.
It appears that sqlInterpolate have been created to prevent security breach trough sql injection attacks (https://shiny.rstudio.com/articles/sql-injections.html), not allowing to use multiple input.
Thanks to parameterized queries (https://db.rstudio.com/best-practices/run-queries-safely) I was able to implement multiple in the query using sql_glue function.
Here are the usefull links for next ones :
glue documentation (https://glue.tidyverse.org/reference/glue_sql.html)
some similar topic (https://community.rstudio.com/t/using-multiple-r-variables-in-sql-chunk/2940/13)
similar with dbQuoteIdentifier function (How to use dynamic values while executing SQL scripts in R)
And the final code :
library(RPostgreSQL)
library(gdal)
library(leaflet)
library(shiny)
library(tidyverse)
library(sp)
library(rgeos)
library(rgdal)
library(DT)
library(knitr)
library(raster)
library(sf)
library(postGIStools)
library(rpostgis)
library(shinydashboard)
library(zip)
library(pool)
library(rjson)
library(reprex)
library(glue)
pool <- dbPool(drv = dbDriver("PostgreSQL", max.con = 100), user = "username", password = "pswd", host = "000.000.00.000", port = 5432, dbname = "database", idleTimeout = 3600000)
typology <- dbGetQuery(pool, "SELECT type FROM table GROUP BY type")
all_typo <- sort(unique(typology$type))
area_table <- dbGetQuery(pool, "SELECT area FROM tableGROUP BY area")
all_area <- sort(unique(area_table$area ))
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
selectInput(
inputId = "area",
label = "Select a district",
choices = all_area,
selected = 'area1',
multiple = TRUE,
selectize = FALSE
),
selectInput(
inputId = "typo",
label = "Select a type",
choices = all_typo,
selected = 'type1',
multiple = TRUE,
selectize = FALSE
)
),
mainPanel(
tabsetPanel(
tabPanel("graph", plotOutput("plot")),
tabPanel("Table", dataTableOutput("table"))
)
)
)
)
server <- function(input, output, session) {
selectedData <- reactive({
req(input$area)
req(input$typo)
query <- glue::glue_sql(
"SELECT year, SUM(surface)
FROM table
WHERE area IN ({area_name*})
AND type IN ({type*})
GROUP BY year;",
area_name = input$area,
type = input$typo,
.con = pool)
outp <- as.data.frame(dbGetQuery(pool, query))
outp
})
output$table <- DT::renderDataTable({
DT::datatable( data = selectedData(),
options = list(pageLength = 14),
rownames = FALSE)
})
output$plot <- renderPlot({
ggplot( data = selectedData(), aes(x = year, y = sum)) + geom_point()
})
}
shinyApp(ui = ui, server = server)
I am new to R and i am using shiny package to build a shiny app that can take different type of queries and those queries takes dynamic user id provided by users on ui level and also i want to show the demo of result of query on ui.
So, my problem is that i am not able to store the query results into an data frame also on clicking on Download button csv is not storing in my system. my code is below. thanks.
###server
library(shiny)
library(RMySQL)
shinyServer(function(input, output) {
datasetInput <- reactive({
switch(input$queryset,
"CDR" = cdr,
"ASSET" = ast,
"USAGE" = usg)
})
output$tbl <- renderTable({
conn <- dbConnect(drv = RMySQL::MySQL(),dbname = "xxxx",
host = "xxxxxx",
username = "xxxxx",
password = "xxxxx"),
q<-dbSendQuery(conn,paste0("select * from table where user_id='",input$user_id,"' and start_time >= '2016-07-16' and start_time < '2016-07-28' order by start_time limit 10 ;",sep = ""
))
dat<- dbFetch(q,n=-1)
on.exit(dbDisconnect(conn), add = TRUE)
})
output$view <- renderTable({
head({dat}, n = input$nrows)
})
output$downloadData <- downloadHandler(
filename = function() { paste(input$user_id, '.csv', sep='') },
content = function(file) {
write.csv({dat}, file)
})
}
)
###ui
library(shiny)
shinyUI(fluidPage(
titlePanel("My App"),
sidebarLayout(
sidebarPanel(
selectInput("queryset", "Choose the type of query:",
choices = c("CDR", "ASSET", "USAGE")),
numericInput("nrows", "Enter the no. of observations:", 10),
numericInput("user_id", "Enter user_id:", 0),
downloadButton('downloadData', 'Download',class = NULL)
),
mainPanel(
tableOutput("view")
)
)
))