I am triyng to use a selectInput to subset a data.table to the selected column, preserving its name. So far I have done:
library(data.table)
mtcars <- data.table(mtcars)
ui <- bootstrapPage(
uiOutput('variables'),
tableOutput('table')
)
server <- function(input, output) {
output$variables<- renderUI ({
selectInput('var',
label = 'select Vars:',
choices = as.list(colnames(mtcars)),
multiple = F)
})
df <- reactive({
df <- mtcars[, list(var_name=get(input$var)), ]
})
output$table <- renderTable({head(df())})
}
shinyApp(ui = ui, server = server)
and the output is
But what I really wants is that the column name is the same as in the original df.
I have tried options with no success, like:
df <- mtcars[, list(input$var), ]
df <- mtcars[, list(paste0(input$var)=get(input$var)), ]
but neither gave me the desired output...
Any ideas ?
thanks in advance
Do you mean something like this? :
df <- reactive({
df <- mtcars[, list(var_name=get(input$var)), ]
colnames(df) <- input$var
df
})
Obviously you can then edit the colname to something else as well
You could re-assign the column name after you subset:
df <- reactive({
df <- mtcars[, list(var_name=get(input$var)), ]
colnames(df) <- input$var
return(df)
})
Related
I would like to update both a data.frame and a DT::datatable interactively when editing the datatable cells. This works fine but when I use the selectInput function to filter the data.frame and edit cells in another row of the datatable, it just copies the values I edited previously both in the data.frame and datatable. Any suggestions?
Below, is a reproducible example. I guess that this is an issue of reactivity. Being new to Shiny I am still far from mastering that.
library(tidyverse); library(DT); library(shiny)
df <- data.frame(internal_idNew=c(1, 2, 3, 4), col_1=c("this", "is", "a", "column"))
ui <- fluidPage(
#filter df
selectInput("s_internal_idNew", "Record id (new)", choices=c(1:nrow(df))),
#dt output
dataTableOutput("dt")
)
server <- function(input, output) {
#reactive df
df <- reactiveVal({df})
#reactive df filtered
df_showed <- reactiveVal({})
observeEvent(input$s_internal_idNew, {
#filter a row matching the internal id
df_showed(df() %>% filter(internal_idNew==input$s_internal_idNew))
#render dt
output$dt <- DT::renderDataTable(df_showed(), editable=list(target = "cell", disable = list(columns =c(0))), options=list(dom = 't', bSort=FALSE, pageLength=1), rownames = FALSE, selection = "none")
#create proxy dt
dt_proxy <- dataTableProxy("dt")
#edit dt
observeEvent(input$dt_cell_edit, {
this <- df()
showed <- df_showed()
#extract edited value to edit df
col_name <- showed %>% names() %>% .[input$dt_cell_edit$col+1]
row_name <- input$s_internal_idNew %>% as.numeric()
value_name <- coerceValue(input$dt_cell_edit$value, showed[row_name, col_name])
#store edited values in reactive df
this[row_name, col_name] <- value_name
df(this)
#replace data in datatable
replaceData(dt_proxy, df_showed(), resetPaging = TRUE, rownames = FALSE)
})
})
}
shinyApp(ui = ui, server = server)
A few modifications to achieve expected behavior :
dtProxy should be created only once at server launch
observeEvent(input$dt_cell_edit,...) should be independent of observeEvent(input$s_internal_idNew,...)
df_showed() should also be updated, as df()
library(tidyverse); library(DT); library(shiny)
df <- data.frame(internal_idNew=c(1, 2, 3, 4), col_1=c("this", "is", "a", "column"))
ui <- fluidPage(
#filter df
selectInput("s_internal_idNew", "Record id (new)", choices=c(1:nrow(df))),
#dt output
dataTableOutput("dt")
)
server <- function(input, output) {
#reactive df
df <- reactiveVal({df})
#reactive df filtered
df_showed <- reactiveVal({})
#create proxy dt once
dt_proxy <- dataTableProxy("dt")
observeEvent(input$s_internal_idNew, {
#filter a row matching the internal id
df_showed(df() %>% filter(internal_idNew==input$s_internal_idNew))
#render dt
output$dt <- DT::renderDataTable(df_showed(), editable=list(target = "cell", disable = list(columns =c(0))), options=list(dom = 't', bSort=FALSE, pageLength=1), rownames = FALSE, selection = "none")
})
#edit dt - separate from previous reactive
observeEvent(input$dt_cell_edit, {
this <- df()
showed <- df_showed()
#extract edited value to edit df
col_name <- showed %>% names() %>% .[input$dt_cell_edit$col+1]
row_name <- input$s_internal_idNew %>% as.numeric()
value_name <- coerceValue(input$dt_cell_edit$value, showed[row_name, col_name])
#store edited values in reactive df
this[row_name, col_name] <- value_name
df(this)
df_showed(this[row_name, ]) # Also updated
#replace data in datatable
replaceData(dt_proxy, df_showed(), resetPaging = TRUE, rownames = FALSE)
})
}
shinyApp(ui = ui, server = server)
I am trying to do something that is quite simple to achieve in R script but I am struggling to replicate when part of a Shiny app. I am reading a file using ‘reactive({})’ (this part in the test code provided below has been replaced with test dataset, lines 13-16). I would like to take variable ‘Species’ entries and assign them to the data frame row names. I have tried two approaches
Inside the “reactive({})” statement, lines 13-16
By creating a new data frame df1, lines 18-20
but both ways don’t work for some reason.
Big thank you in advance!
library(shiny)
library(DT)
library(datasets)
ui <- basicPage("",
DT::dataTableOutput("table"),
verbatimTextOutput("head1"),
verbatimTextOutput("head2")
)
server <- function(input, output, session) {
df <- reactive({
df <- data.frame(v1=c("a", "b"), v2=c(10,20))
# row.names(df) <- df[,1] # THIS DOES NOT WORK
})
df1 <- reactive({ # THIS ALSO DOESN'T WORK
row.names(df()) <- df()[,1]
})
# Show data in a table ----
output$table <- DT::renderDataTable({
datatable(
{df()},
filter = 'top',
class="cell-border stripe",
rownames = TRUE
) # end of datatable
})
output$head1 <- renderPrint({
head(df())
})
output$head2 <- renderPrint({
head(df1())
})
}
shinyApp(ui = ui, server = server)
Try this
library(shiny)
library(DT)
library(datasets)
ui <- basicPage("",
DTOutput("table"),
DTOutput("head1"),
DTOutput("head2")
)
server <- function(input, output, session) {
df <- reactive({
df <- data.frame(v1=c("a", "b"), v2=c(10,20))
row.names(df) <- df[,1] # THIS WORKs
df
})
df1 <- reactive({ # THIS ALSO WORKs
data <- df()
row.names(data) <- df()[,1]
data
})
# Show data in a table ----
output$table <- renderDT({
datatable(
{df()},
filter = 'top',
class="cell-border stripe",
rownames = TRUE
) # end of datatable
})
output$head1 <- renderDT({
head(df())
})
output$head2 <- renderDT({
head(df1())
})
}
shinyApp(ui = ui, server = server)
I am trying to use auto generated selectInput IDs inside the reactive element or observe event. When I explicitly write the input IDs like input$dfSelect1,input$dfSelect2,input$dfSelect3, it works as I wanted.
Since I don't know in advance how many IDs will be there (data will be user input), I need to create same input ID strings as automated, but it doesn't recognize it as a trigger in observe event or a input data in reactive element.
Here is the minimal reproducible example of my problem. if you comment out the line 1 req(input$dfSelect1,input$dfSelect2,input$dfSelect3) and line 2 dfx <- data.frame(carb = c(input$dfSelect1,input$dfSelect2,input$dfSelect3),stringsAsFactors = F) and remove the comment from the following lines, this will be the case I am trying to do.
any idea how to pass these values?
library(dplyr)
library(DT)
exdata <- head(mtcars, 3)
exdata$ROWs <- row.names(exdata)
ui <- fluidPage(
headerPanel("Example"),
mainPanel(
uiOutput("selectionUI"),
uiOutput("tableOutput")
)
)
server <- function(input, output, server) {
### reqString result <- input$dfSelect1,input$dfSelect2,input$dfSelect3
reqString <- noquote(paste0(unlist(lapply(1:length(sort(unique(row.names(exdata)))),function(i) {paste0("input$dfSelect",i,"")})),collapse = ","))
values <- reactiveValues(
upload_state = NULL
)
observe({
### 1-USE the line below with reqString instead -doesn't work ##
req(input$dfSelect1,input$dfSelect2,input$dfSelect3)
# req(reqString)
values$upload_state <- 'uploaded'
})
output$selectionUI <- renderUI({
df <- sort(unique(row.names(exdata)))
wellPanel(
lapply(1:length(df), function(i) {selectizeInput(paste0("dfSelect",i,""),df[i],choices=c("", unique(exdata$carb)))})
)
})
completeTable <- reactive({
browser()
if (is.null(values$upload_state)) {
return(exdata)
}else if (values$upload_state == 'uploaded') {
### 2-USE the line below with reqString instead -doesn't work##
dfx <- data.frame(carb = c(input$dfSelect1,input$dfSelect2,input$dfSelect3),stringsAsFactors = F)
# dfx <- data.frame(carb = c(reqString),stringsAsFactors = F)
dfx <- data.frame(carb =as.numeric(unlist(dfx)))
dataJoin <- exdata %>% left_join(dfx,by=("carb"))
}
})
output$tableOutput <- renderUI({
DT::dataTableOutput("dataTableServer")
})
output$dataTableServer <- DT::renderDataTable({
DT::datatable(completeTable())
})
}
shinyApp(ui = ui, server = server)
You can index input using [[ instead of $:
sapply(1:length(sort(unique(row.names(exdata)))),
FUN=function(x) req(input[[paste0("dfSelect", x)]]))
and
l <- sapply(1:length(sort(unique(row.names(exdata)))),
FUN=function(x) input[[paste0("dfSelect", x)]])
dfx <- data.frame(carb = l,stringsAsFactors = F)
I don't really know to hook up mutate with reactive when dealing with names of columns that are numerical.
I've got data that looks something like this:
df <- tibble(a=c("a", "b", "c"), `1990`=c(1,2,3), `2010`=c(3,2,1))
Everything looks fine when I do:
p <- df %>%
mutate(newvar = `1990`)
But I want to use it in my Shiny App such that newvar is assigned to the input from select list.
I created this reactive for that;
selectedyear <- reactive({
input$select
})
But now it doesn't seem to work:
p <- df %>%
mutate(newvar = selectedyear())
I tried different modifications, like:
p <- df %>%
mutate(newvar = `selectedyear()`)
but nothing seems to work for me.
The full code of the app:
library(shiny)
library(tibble)
library(dplyr)
df <- tibble(a=c("a", "b", "c"), `1990`=c(1,2,3), `2010`=c(3,2,1))
ui <- fluidPage(
selectInput("select", "Select:", c(1990, 2010)),
tableOutput("val")
)
server <- function(input, output) {
selectedyear <- reactive({
input$select
})
output$val <- renderTable({
p <- df %>%
mutate(temperature = selectedyear())
p
})
}
shinyApp(ui, server)
The same thing, but with characters as input is easy. Do you know some hack around this?
You can do
output$val <- renderTable({
p <- df %>%
mutate(temperature = !!selectedyear())
p
})
The problem seems to be the non-syntactic name of the columns 1990, 2010. The approach below should work. It uses eval/parse inside the right hand side of the mutate call. Note that you usually do not need to create reactives of (and with only) inputs, because each input is already reactive.
library(shiny)
library(tibble)
library(dplyr)
df <- tibble(a=c("a", "b", "c"), `1990`=c(1,2,3), `2010`=c(3,2,1))
ui <- fluidPage(
selectInput("select", "Select:", c(1990, 2010)),
tableOutput("val")
)
server <- function(input, output) {
output$val <- renderTable({
df %>%
mutate(temperature = eval(parse(text = paste0("`", input$select,"`"))))
})
}
shinyApp(ui, server)
If you are only interested in the temperature column and you do not need to show the rest of the data, then dplyr::select lets you access the input$select variable in a much more straightforward fashion:
output$val <- renderTable({
df %>%
select(temperature = input$select)
})
In my reactive dataframe, one column has a reactive name (chosen by the user) and I would like to generate a column whose values are the logarithm of the original column. To do so, I use mutate in the dplyr package. However, when I try to make the name of this new column reactive, there's an error.
For example, in the code below, I name the new column "logarithm" and it works fine:
library(shiny)
library(DT)
library(data.table)
library(dplyr)
ui <- fluidPage(
titlePanel(""),
fluidRow(
checkboxInput(inputId = "logarithm",
label = "Log(variable)"),
dataTableOutput("my_df"),
textInput("new_name",
label = "New_name"),
actionButton("new_name2", "Validate")
)
)
server <- function(input, output) {
data <- head(mtcars[, 1:3])
reactive_data <- eventReactive(input$new_name2, {
colnames(data) <- c("mpg", "cyl", input$new_name)
data
})
output$my_df <- renderDataTable({
data <- reactive_data()
if(input$logarithm){
data %>%
mutate(logarithm = log(data[, input$new_name]))
}
else {
data
}
})
}
shinyApp(ui = ui, server = server)
But change "logarithm" by "logarithm(input$new_name)" and it won't work anymore.
Does anybody have a solution?
Based on this question and answer
if(input$logarithm){
log_name <- paste0('logarithm(', input$new_name, ')')
data %>%
mutate(!!log_name := log(data[, input$new_name]))
}
Full code:
library(shiny)
library(DT)
library(data.table)
library(dplyr)
ui <- fluidPage(
titlePanel(""),
fluidRow(
checkboxInput(inputId = "logarithm",
label = "Log(variable)"),
dataTableOutput("my_df"),
textInput("new_name",
label = "New_name"),
actionButton("new_name2", "Validate")
)
)
server <- function(input, output) {
data <- head(mtcars[, 1:3])
reactive_data <- eventReactive(input$new_name2, {
colnames(data) <- c("mpg", "cyl", input$new_name)
data
})
output$my_df <- renderDataTable({
data <- reactive_data()
if(input$logarithm){
log_name <- paste0('logarithm(', input$new_name, ')')
data %>%
mutate(!!log_name := log(data[, input$new_name]))
}
else {
data
}
})
}
shinyApp(ui = ui, server = server)