I am new to shiny and trying to figure out some reactive stuff.
Currently this works for a static csv.
## function to return random row from twitter csv
tweetData <- read.csv('twitterData1.csv')
## stores reactive values
appVals <- reactiveValues(
tweet = tweetData[sample(nrow(tweetData), 1), ],
ratings = data.frame(tweet = character(), screen_name = character(), rating = character())
)
I need the same block of reactive values to be funciton but using a selected csv using input$file.
appVals <- reactiveValues(
csvName <- paste0('../path/', input$file),
tweetData <- read.csv(csvName),
tweet = tweetData[sample(nrow(tweetData), 1), ],
ratings = data.frame(tweet = character(), screen_name = character(), rating = character())
)
I get the error:
Warning: Error in : Can't access reactive value 'file' outside of reactive consumer.
I've tried moving things around but I keep getting stuck, help appreciated!
The error is telling that you should update the values inside a reactive expression.
First initialize the reactive values:
tweetData <- read.csv('twitterData1.csv')
appVals <- reactiveValues()
appVals$tweet <- tweetData[sample(nrow(tweetData), 1), ]
appVals$ratings <- data.frame(tweet = character(), screen_name = character())
Then update them with a reactive:
observeEvent(input$file,{
csvName <- paste0('../path/', input$file)
if (file.exists(csvName) {
tweetData <- read.csv(csvName)
appVals$tweet = tweetData[sample(nrow(tweetData), 1), ]
appVals$ratings = data.frame(tweet = character(), screen_name = character(), rating = character())
}
})
Related
I need to be able to access each variable's data in my data frame, after the user has selected and uploaded a local csv file. This code is the part of my Shiny script where I create and modify the csv file read in by the user. "rv" is the data, which is a reactiveValues dataframe, so it can be modified.
Variable names are chosen by the user through a radio button group (shown here, but defined in the ui part of the script). The other code is in the server portion of the script.
radioButtons('radiovarGroup1',label = h5("Choose a Variable to Analyze:"),
choices = list('TA' = 'TA','PP' = 'PP', 'US' = 'us', 'UD' = 'ud', 'UE' = 'ue',
'UG' = 'ug', 'UH' = 'uh', 'XR' = 'xr', 'RW' = 'rw', 'PA' = 'pa', 'TB4' = 'tb4',
'TV2' = 'tv2', 'TV4' = 'tv4', 'TV8' = 'tv8', 'TV20' = 'tv20', 'TV40' = 'tv40',
'MV2' = 'mv2', 'MV4' = 'mv4', 'MV8' = 'mv8', 'MV20' = 'mv20', 'MV40' = 'mv40',
'VB' = 'vb', 'TA40' = 'ta40', 'TA120' = 'ta120', 'SD' = 'sd'),inline = TRUE, selected = NULL),
var_names = c('TA','PP','US','UD','UE','UG','UH','XR','RW','PA','TB4','TV2','TV4',
'TV8','TV20','TV40','MV2','MV4','MV8','MV20','MV40','VB','TA40','TA120','SD')
rv <- reactiveValues(df = NULL)
#This function is responsible for loading in the selected file
observe({
req(input$file_selector)
rv$df <- read.csv(paste0(parseDirPath(c(home = 'C:\\Users\\Ruben\\Desktop\\Test_QC_Program\\FiveMin'), file_dir()),'\\',input$file_selector),skip=1) # Simplified for testing
})
# This previews the CSV data file
output$filetable <- renderDataTable({
rv$df
})
observeEvent(input$qc_final_cols, {
if (input$qc_final_cols){
for (v in 1:length(var_names)){
ind <- which(colnames(rv$df) == var_names[v])
rv$df <- rv$df %>%
add_column(z = NA,.after = ind)
colnames(rv$df)[ind+1] <- paste0(var_names[v],'_QC')
rv$df <- rv$df %>%
add_column(y = NA,.after = ind+1)
colnames(rv$df)[ind+2] <- paste0(var_names[v],'_Final')
}
}
})
output$checked_var <- renderPrint({
input$radiovarGroup1})
variable_data <- reactive({get(rv$df[,which(colnames(rv$df) == input$radiovarGroup1)])})
Why do I keep getting an "object of type closure is not subsettable' error returned for variable_data? I can render the rv$df data table just fine, but I can't extract data from it for some reason.
I am attempting to add the values from a checkboxgroupinput value to the data frame called surv_data in a Shiny App.
Below is the code for the check boxes:
checkboxGroupInput(inputId = "variables", label = "",
choices = c(
"Covariate 1" = "cov1",
"Covariate 2" = "cov2"
),
selected = c('cov1', 'cov2'))
Here is where I combine the variables in to one data frame:
surv_data <- reactive({
raw_surv <- raw_surv_data()
data.frame(
Time = raw_surv[[input$Time]],
Treatment = raw_surv[[input$Treatment]],
endpoint = raw_surv[[input$Endpoint]]
)
})
I need to somehow add the values cov1 and cov2 below the following line:
endpoint = raw_surv[[input$Endpoint]]
I've attempted to add variables = raw_surv[[input$variables]] but unfortunately this does not work. Any help would be appreciated.
Maybe
surv_data <- reactive({
raw_surv <- raw_surv_data()
cbind(
data.frame(
Time = raw_surv[[input$Time]],
Treatment = raw_surv[[input$Treatment]],
endpoint = raw_surv[[input$Endpoint]]
),
raw_surv[input$variables]
)
})
My problem is that I have a given data frame and I have to search for different patterns. When the pattern matches the given character vector the content of the same row, but of a different column should update a textInput.
I created a little shiny app as an example, because my original code is too big. The example works, but I'm using for loops and I don't want to do this. Do anyone know a better solution? Is there a solution with a vectorised function? I really would appreciate if someone knows a dplyr solution.
Example:
library(shiny)
ui <- fluidPage(
textInput(inputId="wave1", label="wavelength"),
textInput(inputId="wave2", label="wavelength")
)
server <- name <- function(input,output,session) {
df <- data.frame("color" = c("red","blue","green"), "wavelength" = c("700 nm","460 nm","520 nm"))
for (i in 1:nrow(df)) {
if(grepl("lue",df$color[i],fixed=TRUE) == TRUE){updateTextInput(session, inputId="wave1", label = NULL, value = df$wavelength[i],placeholder = NULL)}
}
for (i in 1:nrow(df)) {
if(grepl("ee",df$color[i],fixed=TRUE) == TRUE){updateTextInput(session, inputId="wave2", label = NULL, value = df$wavelength[i],placeholder = NULL)}
}
}
shinyApp(ui = ui, server = server)
Any help would be appreciated.
Instead of looping, you can index the dataframe directly from the result of grep:
server <- name <- function(input,output,session) {
df <- data.frame("color" = c("red","blue","green"), "wavelength" = c("700 nm","460 nm","520 nm"))
updateTextInput(session, inputId="wave1", label = NULL,
value = df$wavelength[grep("lue", df$color, fixed=TRUE)],
placeholder = NULL)
updateTextInput(session, inputId="wave2", label = NULL,
value = df$wavelength[grep("ee", df$color, fixed=TRUE)],
placeholder = NULL)
}
And one way to do this using dplyr is:
server <- name <- function(input,output,session) {
df <- data.frame("color" = c("red","blue","green"), "wavelength" = c("700 nm","460 nm","520 nm"))
updateTextInput(session, inputId="wave1", label = NULL,
value = dplyr::filter(df, grepl("lue", color, fixed=TRUE)) %>% dplyr::pull(wavelength),
placeholder = NULL)
updateTextInput(session, inputId="wave2", label = NULL,
value = dplyr::filter(df, grepl("ee", color, fixed=TRUE)) %>% dplyr::pull(wavelength),
placeholder = NULL)
}
I made a shiny dashboard that connects to a postegreDB and get a value from a table, then subset it, and then transform it to a wide format using reshape2. I want to update the value directly from the dashboard, and then push them into the database.
I used this link for inspiration: https://github.com/MangoTheCat/dtdbshiny
This is the code I made:
server <- function(input, output, session) {
# Generate reactive values
rvs <- reactiveValues(
data = NA,
dataWide = NA,
dataSub = NA,
cdfilTmp = NA,
cdfilTmp2 = NA,
dataWideTmp = NA,
dbdata = NA,
dataSame = TRUE,
req = NA,
tabId = NA,
listeSeuil = NA,
dataMod = NA
)
# Generate source via reactive expression
mysource <- reactive({
dbGetQuery(pool, "SELECT * from bilanmasse.v_export_r_scen_seuil")
})
# Observe the source, update reactive values accordingly
observeEvent(mysource(), {
# Lightly format data by arranging id
# Not sure why disordered after sending UPDATE query in db
data <- mysource() %>% arrange(idscenar)
data <- dbGetQuery(pool, "SELECT * from bilanmasse.v_export_r_scen_seuil")
rvs$cdfilTmp <- paste(data$ordreseuil, data$nomfiliere, sep="-")
data$cdfiliere <- rvs$cdfilTmp
data <- data[c("idscenar", "nomscenar", "codeparam", "cdusage", "cdlithoprof", "cdfiliere", "valseuil")]
rvs$data <- data
rvs$dbdata <- data
rvs$listeSeuil <- unique(rvs$data[,1])
rvs$tabId <- dbGetQuery(pool, "SELECT * from bilanmasse.scenar_testr")
updateSelectInput(session, "listScen",
label = "Choix du scenario",
choices = isolate(rvs$listeSeuil)
)
})
rvs$dataSub <- reactive({ subset(rvs$data, rvs$data[,1] == input$listScen) })
rvs$dataWide <- reactive({ dcast(rvs$dataSub(), idscenar+nomscenar+codeparam+cdusage+cdlithoprof~cdfiliere, value.var="valseuil") })
rvs$dataWideTmp <- reactive({ rvs$dataWide() })
ScenBase <- reactive({ subset(rvs$data, rvs$data[,1] == 2) })
listeParam <- reactive({ unique(ScenBase()[,3]) })
listeUsage <- reactive({ unique(ScenBase()[,4]) })
listeLithoProf <- reactive({ unique(ScenBase()[,5]) })
listeTraitement <- reactive({ unique(ScenBase()[,6]) })
#
# render the table
output$tabScSeuil <- renderDataTable(
rvs$dataWide(), rownames = FALSE, editable = TRUE, selection = 'none', filter= "top", options = list(
columnDefs = list(list(className = 'dt-center', targets = "_all")))
)
proxy3 = dataTableProxy('tabScSeuil')
observeEvent(input$tabScSeuil_cell_edit, {
info = input$tabScSeuil_cell_edit
i = info$row
j = info$col = info$col + 1 # column index offset by 1
v = as.numeric(info$value)
rvs$dataWideTmp[i,j] <- v
output$test <- renderPrint(rvs$dataWideTmp[i,j])
})
}
Everything work perfectly expect when I want to update the new value into the table: I got this error:
Error in [: object of type 'closure' is not subsettable
So I tried to use an SQL request instead of a subset:
observeEvent(input$listScen, {
val <- as.character(input$listScen)
req <- paste0("SELECT * from bilanmasse.v_export_r_scen_seuil WHERE idscenar = ", val)
observeEvent(input$listScen, { dataSub <- dbGetQuery(pool, req) })
#cdfilTmp2 <- paste(dataSub[,6], dataSub[,7], sep="-")
#dataSub[,9] <- cdfilTmp2
#dataSub <- dataSub[c("idscenar", "nomscenar", "codeparam", "cdusage", "cdlithoprof", "V9", "valseuil")]
#colnames(dataSub) <- c("idscenar", "nomscenar", "codeparam", "cdusage", "cdlithoprof", "cdfiliere", "valseuil")
#dataWide <- dcast(dataSub, idscenar+nomscenar+codeparam+cdusage+cdlithoprof~cdfiliere, value.var="valseuil")
#dataWideTmp <-dataWide
output$test <- renderPrint(req)
})
But I got a weird error, when I print req, the request is OK:
[1] "SELECT * from bilanmasse.v_export_r_scen_seuil WHERE idscenar =
2"
But in the R console, I got an error:
Warning in postgresqlQuickSQL(conn, statement, ...) : Could not
create execute: SELECT * from bilanmasse.v_export_r_scen_seuil WHERE
idscenar =
Does someone know a solution to make this?
An overview of the project: To connect with a postgres DB that contains id,scores and date, so that a shiny dashboard user can enter the id and next I want to compute an upper and lower ranges for the mean(scores) for that id, so that finally I can display all that in a graph.
Issue: Looks like no data is being read from the DB, error: scores not found
Below is the script:
library(ALL relevant libraries)
drv <- dbDriver("PostgreSQL")
con<-dbConnect(drv,dbname = "", host = "", port = "", user = "", password= "")
# correct credentials placed above
dates <- seq(as.Date(as.character(Sys.Date() - 10)), as.Date(as.character(Sys.Date() - 5)), by = 1)
# dates vector should have 5 days
r <<- length(dates)
ui <- fluidPage(
titlePanel("Score"),
sidebarPanel(numericInput(inputId = "id",label = "user", value = 0000 ,
min = 100, max = 1000000)),
mainPanel(plotOutput("Coolplot"))
)
server <- function(input, output, session) {
browser()
generate <- function(r) {
listofdfs <- list() # Create a list in which you intend to save your df's.
for (i in 1:length(dates)) {
data <- dbGetQuery(con, sprintf("select score, CAST (date AS date), id from My_Table
where id = ",input$id," and
date<=date('%s') and date>=date('%s')- INTERVAL '7 day'",dates[i],dates[i]))
# changed the date<='%s' to date<=date('%s') now at least can read the data.
data$score_mean <- mean(data[,1])
data$upper_threshold <- data$score_mean * 1.2
data$lower_threshold <- data$score_mean * 0.8
listofdfs[[i]] <- data # save your dataframes into the list
}
return(listofdfs) #Return the list of dataframes.
}
df <- as.data.frame(do.call("rbind", generate(r)))
df<-reactive({df[!duplicated(df$date)]}) #since data needed some subsetting
output$Coolplot <- renderPlot({
browser()
ggplot(df(), aes(date)) +
geom_line(aes(y = score, colour = "score"))+
geom_line(aes(y = upper_threshold, colour = "upper_threshold")) +
geom_line(aes(y = lower_threshold, colour = "lower_threshold"))
})
}
shinyApp(ui = ui, server = server)
Thank you all for your help.
Cheers!
I don't think you should set an initial value under the min
sidebarPanel(numericInput(inputId = "id",label = "user", value = 0000 , min = 100, max = 1000000)),
=>
sidebarPanel(numericInput(inputId = "id",label = "user", value = 100 , min = 100, max = 1000000)),
Keep generate as a regular function returning something based on provided parameters
generate <- function(r) {
=>
generate <- function(user_id) {
don't mix up sprintf with paste and prevent SQL injection
sprintf("select score, CAST (date AS date), id from My_Table where id = ",input$id," and date<=date('%s') and date>=date('%s')- INTERVAL '7 day'",dates[i],dates[i]))
=>
sprintf("select score, CAST (date AS date), id from My_Table where id = %d and date<=date('%s') and date>=(date('%s')- INTERVAL '7 day')", as.numeric(user_id), as.date(dates[i]), as.date(dates[i])))
Add all your data manipuation within the reactive that references input parameters
df <- as.data.frame(do.call("rbind", generate(r)))
df<-reactive({df[!duplicated(df$date)]})
=>
df<-reactive({
data <- as.data.frame(do.call("rbind", generate(input$id)))
data[!duplicated(data$date)]
})