Setting overwrite == TRUE using memdb and dbplyr - sql

The following shiny app works the first time you run it, but then errors if you change the species input because the table name already exists in memory. I was wondering how to set overwrite == TRUE given the code below?
library(shiny)
library(tidyverse)
library(dbplyr)
ui <- fluidPage(
selectInput("species", "Species", choices = unique(iris$Species),
selected = "setosa"),
tableOutput("SQL_table"),
actionButton("code", "View SQL"),
)
server <- function(input, output) {
# render table
output$SQL_table <- renderTable(
head(iris %>% filter(Species == input[["species"]]))
)
# generate query
SQLquery <- reactive({
sql_render(
show_query(
tbl_memdb(iris) %>%
filter(Species == local(input$species))
)
)
})
# see query
observeEvent( input$code, {
showModal(
modalDialog(
SQLquery()
)
)
})
}
shinyApp(ui = ui, server = server)


since memdb_frame is just a function call of copy_to we can use it directly to set overwrite = TRUE
copy_to(src_memdb(), iris, name = 'iris', overwrite=TRUE)

Related

RShiny Limit for Dropdown [duplicate]

I have written a simple example of what I am doing. I have 3000 numbers that I want to show in a selectInput. The numbers have to be in a reactive function, since in my original work, the data is from a file.
My problem is that when I run the app it only appears 1000 numbers, not the entire data (3000 numbers).
I have seen this post Updating selection of server-side selectize input with >1000 choices fails but I don't know how can I do it using uiOutput and renderUI.
Can anyone help me?
Thanks very much in advance
The code:
library(shiny)
ui <- fluidPage(
titlePanel("Numbers"),
sidebarLayout(
sidebarPanel(
uiOutput('selectUI')
),
mainPanel(
)
)
)
server <- function(input, output) {
num <- reactive({
data = c(1:3000)
return(data)
})
output$selectUI <- renderUI({
selectInput(inputId = 'options', "Select one", choices = num())
})
}
# Run the application
shinyApp(ui = ui, server = server)

Use selectizeInput instead of selectInput with the argument options = list(maxOptions = 3000).

Thanks to Stéphane Laurent's answer, the example will be solved like this:
library(shiny)
ui <- fluidPage(
titlePanel("Numbers"),
sidebarLayout(
sidebarPanel(
selectizeInput(inputId = "options", label = "Select one", choices=character(0)),
),
mainPanel(
)
)
)
server <- function(input, output, session) {
num <- reactive({
data = c(1:3000)
return(data)
})
observe({
updateSelectizeInput(
session = session,
inputId = "options",
label = "Select one",
choices= num(), options=list(maxOptions = length(num())),
server = TRUE)
})
}
# Run the application
shinyApp(ui = ui, server = server)
This code will work if you have more than 3000 entries. It will show you ALL the choices that you have. However, if you have a long list of choices (e.g. 60000) it will decrease the speed of your app.

How to return a dataframe as a datatable item on a shiny app

in the following code I managed to return the result of a data summary as a printed text, however I want to return it in a datatable and I never get the wanted result can anyone be of my help?
ui <- fluidPage(
fileInput('file1', 'Upload your CSV File'),
htmlOutput("variables"),
numericInput(inputId="n", label="n", value=4, min=3,step=1),
htmlOutput("facteurs"),
verbatimTextOutput("res"),
DT::dataTableOutput("Tab")
)
server <- function(input, output) {
myData1 <- reactive({
inFile <- input$file1
if (is.null(inFile)) return(NULL)
data <- read.csv(inFile$datapath, header = TRUE,row.names=1)
data
})
output$variables <- renderUI({
req(myData1())
df_init <- myData1()
for(i in c(1:ncol(df_init))){
if((class(df_init[,i])=="integer") && length(unique(df_init[,i]))<=input$n){df_init[,i]<-factor(df_init[,i])}}
x=sapply(df_init,class)
x=(x=="numeric")
df=df_init[,x]
if (identical(df, '') || identical(df,data.frame())) return(NULL)
selectInput(inputId = "V1", label = "Variables to use: Y", choices=names(df), selected=names(df[1]))
})
output$facteurs <- renderUI({
req(myData1())
df_init <- myData1()
for(i in c(1:ncol(df_init))){
if((class(df_init[,i])=="integer") && length(unique(df_init[,i]))<=input$n){df_init[,i]<-factor(df_init[,i])}}
x=sapply(df_init,class)
x=(x=="factor")
df=df_init[,x]
if (identical(df, '') || identical(df,data.frame())) return(NULL)
selectInput(inputId = "F1", label = "Factors to use: X", choices=names(df), selected=names(df))
})
output$res<-renderPrint({
data<-myData1()
if (is.null(data)) return("Enter your data!")
v=c(input$V1,input$F1)
x=data[,v]
print(tapply(x[,1],x[,2],summary))
})
output$Tab<-renderDataTable({
data<-myData1()
if (is.null(data)) return("Enter your data!")
v=c(input$V1,input$F1)
x=data[,v]
DT::datatable(data=tapply(x[,1],x[,2],summary))
})
}
shinyApp(ui = ui, server = server)
I also add to this reproducible code a data sample so you can verify its functionalities
,Var,Lo,ES,Acidity,K232,K270,IP,OS,C 14:0,C 16:0,C 16:1,C 17:0,C 17:1,C 18:0,C 18:1,C 18:2,C 18:3,C 20:0,C 20:1,total,LLL,LnLO,LnLP,LLO,LnOO,PLL,LOO,LOP,PLP,OOO,POP,POO,AOL,SOO,SOP,Chlorophyll,b carotène,polyphenols ,Ethyl acetate,2- Methyl butanal,3- Methyl butanal,1-Penten-3-one,3-Hexanone,Hexanal,3-Pentanol,Trans-2-pentenal,1-Penten-3-ol,Cis-3-hexenal,Trans-2-hexenal,1-Pentanol,Hexyl acetate,Cis-3-hexenyl acetate,Cis-2-pentenol,6-Methyl-5-hepten-2-one,1-Hexanol,Trans-3-hexenol,Cis-3-hexenol,Trans-2-hexenol,Acetic acid,Butyric acid,H- Tyr ,Tyr ,DFOA,DFLA,Ac-Pin,Pin,EAA,OA,LA,total phenols (HPLC)
P1,chetoui,beja,sp,0.93,1.49,0.2,9.2,16.51,0.01,13.5,0.57,0.07,0.08,2.57,67.04,18.56,1.16,0.02,0.39,103.95,0.72,0.45,0.1,7.87,2.63,0.38,22.14,8.8,0.7,33.47,15.84,1.77,0.37,3.95,0.8,5.05,4.1,491.6,2.72,0.29,0.11,0.08,0.1,15.27,1.35,1.55,3.77,22.68,133.13,0.36,9.92,7.14,2.37,0.5,10.03,0.78,121.11,14.12,0.05,0.08,1.91,4.15,10.33,40.52,1.21,5.5,2.92,30.65,2.35,99.53
P2,chetoui,beja,sp,0.36,1.24,0.2,8.2,16.81,0.01,13.39,0.18,0.05,0.07,1.23,69.23,18.63,0.91,0.02,0.28,104,0.69,0.43,0.15,7.81,2.57,0.42,22.21,8.84,0.71,33.87,15.6,2.01,0.38,4.14,1.01,5.88,6.161,457.04,2.52,0.34,0.12,0.09,0.22,15.2,1.32,1.52,3.67,22.61,133.19,0.35,9.89,7.18,2.34,0.51,10.17,0.75,121.21,14.29,0.05,0.02,1.92,4.05,10.45,40.63,1.25,5.55,2.95,31.042,2.17,100.01
P3,chetoui,beja,sp,0.84,1.87,0.21,8.6,16.73,0.01,13.31,0.45,0.06,0.08,2.54,69.29,17.03,0.84,0.02,0.37,104,0.72,0.42,0.12,7.82,2.61,0.43,21.22,8.83,0.72,33.85,15.52,1.92,0.39,4.05,0.95,5.92,6.241,482.12,2.72,0.25,0.08,1.12,0.42,15.01,1.3,1.44,3.93,22.51,133.07,0.39,9.87,7.16,2.31,0.52,10.1,0.76,121.29,14.21,0.06,0.01,1.93,4.12,10.6,40.71,1.26,5.54,2.96,30.43,2.26,99.81

You were not very clear on what you need your output to look like, so here's one way to do it:
output$Tab<-renderDataTable({
data<-myData1()
if (is.null(data)) return("Enter your data!")
v=c(input$V1,input$F1)
x=data[,v]
do.call(cbind, tapply(x[,1],x[,2], summary))
})
or if you'd like it transposed change the cbind to rbind

Uploading csv to SQL table using R shiny

I've been scratching my head trying to figure this out.
So I've connected to the database but when I press the action button nothing is happening to the table.
The CSV is being converted to a data frame.
UI
library(shiny)
library(RJDBC)
library(dbtools)
library(jsonlite)
library(shinyjs)
library(DBI)
# App title ----
titlePanel("Uploading Files"),
# Sidebar layout with input and output definitions ----
sidebarLayout(
# Sidebar panel for inputs ----
sidebarPanel(
# Input: Select a file ----
fileInput("file1", "Choose CSV File",
multiple = TRUE,
accept = c("text/csv",
"text/comma-separated-values,text/plain",
".csv")),
tags$head(
tags$style(HTML(
'#Uploadbutton{background-color:cyan}'
))
),
actionButton("Uploadbutton","Upload"),
p("Upload Members if data looks ok")
),
# Main panel for displaying outputs ----
mainPanel(
# Output: Data file ----
tableOutput("contents")
)
)
)
Server
server <- function(input, output) {
output$contents <- renderTable({
# input$file1 will be NULL initially. After the user selects
# and uploads a file, head of that data file by default,
# or all rows if selected, will be shown.
req(input$file1)
data <- read.csv(input$file1$datapath,header=TRUE)
if(input$disp == "head") {
return(head(data))
}
else {
return(data)
}
data <- data.frame()
data <<- read.csv(input$file1$datapath,header=TRUE)
testdata <- read.csv("data",sep=",",row.names=1)
observeEvent(input$Uploadbutton, {
insert_into("data", "ANALYTICS.TEST_DATASTORE", con=lol, rows_per_statement=1)
})
}
)

Hi I think what you are looking for is something like
DBI::dbWriteTable(con=lol, name = "ANALYTICS.TEST_DATASTORE",value = dta(),append = TRUE)
also I would structure the server function a bit different so that we don't need to use global variables
server <- function(input, output) {
dta <- reactive({
# input$file1 will be NULL initially. After the user selects
# and uploads a file, head of that data file by default,
# or all rows if selected, will be shown.
req(input$file1)
data <- read.csv(input$file1$datapath,header=TRUE)
if(input$disp == "head") {
return(head(data))
}
else {
return(data)
}
})
output$contents <- renderTable({
dta()
})
observeEvent(input$Uploadbutton, {
DBI::dbWriteTable(con=lol, name = "ANALYTICS.TEST_DATASTORE",value = dta(),append = TRUE)
})
}
Hope this helps!

This will upload the file for you. Then, send the data to SQL Server.
library(shiny)
# Define UI for data upload app ----
ui <- fluidPage(
# App title ----
titlePanel("Uploading Files"),
# Sidebar layout with input and output definitions ----
sidebarLayout(
# Sidebar panel for inputs ----
sidebarPanel(
# Input: Select a file ----
fileInput("file1", "Choose CSV File",
multiple = TRUE,
accept = c("text/csv",
"text/comma-separated-values,text/plain",
".csv")),
# Horizontal line ----
tags$hr(),
# Input: Checkbox if file has header ----
checkboxInput("header", "Header", TRUE),
# Input: Select separator ----
radioButtons("sep", "Separator",
choices = c(Comma = ",",
Semicolon = ";",
Tab = "\t"),
selected = ","),
# Input: Select quotes ----
radioButtons("quote", "Quote",
choices = c(None = "",
"Double Quote" = '"',
"Single Quote" = "'"),
selected = '"'),
# Horizontal line ----
tags$hr(),
# Input: Select number of rows to display ----
radioButtons("disp", "Display",
choices = c(Head = "head",
All = "all"),
selected = "head")
),
# Main panel for displaying outputs ----
mainPanel(
# Output: Data file ----
tableOutput("contents")
)
)
)
# Define server logic to read selected file ----
server <- function(input, output) {
output$contents <- renderTable({
# input$file1 will be NULL initially. After the user selects
# and uploads a file, head of that data file by default,
# or all rows if selected, will be shown.
req(input$file1)
df <- read.csv(input$file1$datapath,
header = input$header,
sep = input$sep,
quote = input$quote)
if(input$disp == "head") {
return(head(df))
}
else {
return(df)
}
})
}
# Run the app ----
shinyApp(ui, server)

Thanks for all the help guys figured out how to do it this was the server side.
server <- function(input, output, session) {
output$contents <- DT::renderDataTable({
# input$file1 will be NULL initially. After the user selects
# and uploads a file, head of that data file by default,
# or all rows if selected, will be shown.
req(input$file1)
data <- read.csv(input$file1$datapath,header=TRUE)
return(data)
})
observeEvent(input$Uploadbutton,
{insert_into(read.csv(input$file1$datapath),"ANALYTICS.TEST_DATASTORE")},once=TRUE
)
}

Create Shiny DataTable based on selected input

The following code (within my shiny app) is giving me this error:
"You have an error in your SQL syntax; check the manual that corresponds to your MySQL server version for the right syntax to use near '' at line 1"
shinyServer(function(input, output, session) {
dataTable <- reactive ({
data <- input$dataset
con <-
dbConnect(
drv = dbDriver("MySQL"),
dbname = "Database",
host = 'remote',
port = 3306,
user = "user",
password = "password")
on.exit(dbDisconnect(con))
dbGetQuery(con, paste("select * from ", data, ";"))
})
output$myTable <- renderDataTable({
datatable(dataTable(),
rownames = FALSE,
filter = "top",
extensions = 'Buttons',
options = list(dom = 'Bfrtip', buttons = I('colvis')))
})
})
shinyUI(fluidPage(
titlePanel("Data Search"),
# SidePanel -------------------------------------------
# -The Input/Dropdown Menu that Control the Output
sidebarLayout(
sidebarPanel(
selectInput(
inputId = "dataset",
label = "Select Dataset",
choices = c("", "Schools", "GradRates"),
selected = "",
multiple = FALSE),
width = 3
),
# MainPanel -------------------------------------------
# -The Output/Table Displayed Based on Input
mainPanel(
dataTableOutput(outputId = "myTable"),
width = 9
)
))

You have most likely problem with this line
dbGetQuery(con, paste("select * from ", data, ";"))
It appears that variable data doesn't contain table name as expected. Check your code where you are inserting table name into data.

Avoid re-loading datasets within a reactive in shiny

I have a shiny app that requires the input from one of several files. A simplified example would be:
library(shiny)
x <- matrix(rnorm(20), ncol=2)
y <- matrix(rnorm(10), ncol=4)
write.csv(x, 'test_x.csv')
write.csv(y, 'test_y.csv')
runApp(list(ui = fluidPage(
titlePanel("Choose dataset"),
sidebarLayout(
sidebarPanel(
selectInput("data", "Dataset", c("x", "y"), selected="x")
),
mainPanel(
tableOutput('contents')
)
)
)
, server = function(input, output, session){
myData <- reactive({
inFile <- paste0("test_", input$data, ".csv")
data <- read.csv(inFile, header=FALSE)
data
})
output$contents <- renderTable({
myData()
})
}))
In reality, the files I read in are much large, so I would like to avoid reading them in each time input$data changes, if it has already been done once. For example, by making the matrices mat_x and mat_y available within the environment, and then within myData testing:
if (!exists(paste0("mat_", input$data))) {
inFile <- paste0("test_", input$data, ".csv")
data <- read.csv(inFile, header=FALSE)
assign(paste0("mat_", input$data), data)
}
Is there a way to do this, or do I have to create a separate reactive for mat_x and mat_y and using that within myData? I actually have 9 possible input files, but each user may only want to use one or two.

You could do something like
myData <- reactive({
data <- fetch_data(input$data)
data
)}
fetch_data <- function(input) {
if (!exists(paste0("mat_", input))) {
inFile <- paste0("test_", input, ".csv")
data <- read.csv(inFile, header=FALSE)
assign(paste0("mat_", input), data)
} else {
data <- paste0("mat_", input)
}
return (data)
}