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)
Related
I want to let the user be able to select "NA" or enter empty values in the sliderInput. Maybe add a "NA" button near the slider input? Is there any way to do that?
example
Thanks
You can add a checkboxInput and pair it with an if condition inside the server. Here's an example using iris dataset.
library(shiny)
library(shinyWidgets)
library(tidyverse)
iris_df <- iris
#populate with some NA's
set.seed(123)
sample(1:nrow(iris), 10) %>%
walk(~ {
iris_df[.x, "Sepal.Width"] <<- NA
})
ui <- fluidPage(
checkboxInput("na", "Select NA Values", value = FALSE),
conditionalPanel(
condition = "input.na == false",
sliderInput("sepalw", "Sepal Width Range",
value = c(median(iris$Sepal.Width), max(iris$Sepal.Width)),
min = min(iris$Sepal.Width),
max = max(iris$Sepal.Width)
)
),
dataTableOutput("table")
)
server <- function(input, output, session) {
df <- reactive({
if (!input$na) {
iris_df %>%
filter(between(Sepal.Width, input$sepalw[[1]], input$sepalw[[2]]))
} else {
iris_df %>% filter(is.na(Sepal.Width))
}
})
output$table <- renderDataTable(
{
df()
},
options = list(pageLength = 10)
)
}
shinyApp(ui, server)
I am building a Shiny app and using the code from this question as an example: How to download editable data table in shiny. However, in my code the df <- reactiveVal(dat) does not work, because the dat itself is already a reactive value that comes from an eventReactive({}) function. This is the code I am working with, it works if I define the dat outside of the server, but not when it is created inside the server function of shiny. How do I make a copy of it so that I can show it in a new table (and potentially process further and download in later steps in the app)?
library(shiny)
library(DT)
library(shinyWidgets)
# if the data frame is just an object, it works
#dat <- iris[1:3, ]
ui <- fluidPage( actionBttn(
inputId = "btnProcess",
label = "Process",
size = "sm",
color = "success"
),
DTOutput("my_table"),
DTOutput("table2")
)
server <- function(input, output){
# if the dataframe is a reactive variable, this doesnt work.
dat <- eventReactive(input$btnProcess, {
iris[1:3, ]
})
output[["my_table"]] <- renderDT({
datatable(dat(), editable = "cell")
})
#############################
#### none of these work #####
#############################
#df <- reactiveVal(dat)
#df <- reactiveVal(dat())
#df <- dat()
#df <- dat
observeEvent(input[["my_table_cell_edit"]], {
cell <- input[["my_table_cell_edit"]]
newdf <- df()
newdf[cell$row, cell$col] <- cell$value
df(newdf)
})
output[["table2"]] <- renderDT({
datatable(df())
})
}
shinyApp(ui, server)
Try this
ui <- fluidPage( actionBttn(
inputId = "btnProcess",
label = "Process",
size = "sm",
color = "success"
),
actionBttn(inputId = "reset", label = "Reset", size="sm", color="warning"),
DTOutput("mytable"),
DTOutput("table2")
)
server <- function(input, output){
# if the dataframe is a reactive variable, this doesnt work.
dat <- eventReactive(input$btnProcess, {
iris[1:3, ]
})
mydf <- reactiveValues(data=NULL)
observe({
mydf$data <- dat()
})
output$mytable <- renderDT({
datatable(mydf$data, editable = "cell")
})
observeEvent(input$mytable_cell_edit, {
info = input$mytable_cell_edit
str(info)
i = info$row
j = info$col
v = info$value
mydf$data[i, j] <<- DT::coerceValue(v, mydf$data[i, j])
})
output[["table2"]] <- renderDT({
datatable(mydf$data)
})
observeEvent(input$reset, {
mydf$data <- dat() ## reset it to original data
})
}
shinyApp(ui, 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'm trying to set codes to recode in shiny web application. However, it doesn't work for me.
Here's my code.
library(shiny)
library(rlang)
library(dplyr)
ui <- fluidPage(
titlePanel("Short Form Web App"),
sidebarPanel(
numericInput("num1","previous vector", value = NULL),
numericInput("num2","post vector", value = NULL),
selectInput("var","select Variable",names(mtcars)),
textInput("new_var","new variable names")
),
mainPanel(
verbatimTextOutput("tab1"),
verbatimTextOutput("tab2"),
actionButton("do","Do")
)
)
server <- function(input, output) {
output$tab1 <- renderPrint({
table(mtcars[["cyl"]])
})
rv <- reactiveValues(data = NULL)
rv$data <- mtcars
observeEvent(input$do,{
new_var <- input$new_var
new <- rv$data %>% transmute(!!new_var := case_when(input$var == input$num1 ~ input$num2))
rv$data <- bind_cols(rv$data,new)
output$tab2 <- renderPrint({
str(rv$data)
})
})
}
shinyApp(ui,server)
What I'm trying to do is recode previous vector to new vector like recode, but the result keeps showing NA..
Could anyone help me fix this problem?
I would very be very appreciated with your helps.
Thank you in advance.
Two issues:
As input$var is character you first have to convert to a symbol, i.e. use !!sym(input$var)
In your case_when you missed to set a default value. Hence, all values not specified to be recoded will be assigned NA.
Try this:
library(shiny)
library(rlang)
library(dplyr)
ui <- fluidPage(
titlePanel("Short Form Web App"),
sidebarPanel(
numericInput("num1","previous vector", value = NULL),
numericInput("num2","post vector", value = NULL),
selectInput("var","select Variable",names(mtcars)),
textInput("new_var","new variable names")
),
mainPanel(
verbatimTextOutput("tab1"),
verbatimTextOutput("tab2"),
actionButton("do","Do")
)
)
server <- function(input, output) {
output$tab1 <- renderPrint({
table(mtcars[["cyl"]])
})
rv <- reactiveValues(data = NULL)
rv$data <- mtcars
observeEvent(input$do,{
new_var <- input$new_var
new <- rv$data %>% transmute(!!sym(new_var) := case_when(
!!sym(input$var) == input$num1 ~ as.double(input$num2),
TRUE ~ !!sym(input$var)))
rv$data <- bind_cols(rv$data,new)
output$tab2 <- renderPrint({
str(rv$data)
})
})
}
I am trying to get input choices dependent on previous input.
require(shiny)
require(dplyr)
dat <- data.frame(id1 = c(rep("A",5),rep("B",5)),
id2 = c(rep("C",3),rep("D",3),rep("E",4)),
id3 = c(rep("F",2),rep("G",3),rep("H",5)), stringsAsFactors=FALSE)
ui <- shinyUI(fluidPage(
sidebarPanel(
selectInput('id1', 'ID1', choices = unique(dat$id1)),
selectInput("id2", "ID2", choices = unique(dat$id2)),
selectInput("id3", "ID3", choices = unique(dat$id3))
)
)
)
server <- function(input, output,session) {
observeEvent(
{
input$id1
},{
input$id2
temp <- dat %>% filter(id1%in%input$id1)
updateSelectInput(session,"id2",choices = unique(temp$id2))
}
)
}
shinyApp(ui = ui, server = server)
This works for Input 1 and 2, however if i add another Input to observeEvent, the app chrashes. E.g:
server <- function(input, output,session) {
observeEvent(
{
input$id1
},{
input$id2
temp <- dat %>% filter(id1%in%input$id1)
updateSelectInput(session,"id2",choices = unique(temp$id2))
},{
input$id3
temp <- dat %>% filter(id1%in%input$id1 & id2%in%input$id2)
updateSelectInput(session,"id3",choices = unique(temp$id3))
}
)
}
How can I pass further Inputs to observeEvent ?
Update: I found a solution for the problem. I wrapped the Inputs in a reactive function, split the Output and passed it to the corresponding observeEvent functions.
server <- function(input, output,session) {
change <- reactive({
unlist(strsplit(paste(c(input$id1,input$id2,input$id3),collapse="|"),"|",fixed=TRUE))
})
observeEvent(input$id1,{
temp <- dat %>% filter(id1 %in% change()[1])
updateSelectInput(session,"id2",choices = unique(temp$id2))
}
)
observeEvent(input$id2,{
temp <- dat %>% filter(id1 %in% change()[1] & id2 %in% change()[2])
updateSelectInput(session,"id3",choices = unique(temp$id3))
}
)
}