How to display the entire row of a selected value?
What we have is a drop down menu where a certain values of a defined column can be selected. If one of the values in the the drop down menu is selected the entire row where this value is located should be displayed.
In the following case the values that can be selected in a drop down menu are the letters x, y, z. e.g. If "y" is selected in the drop down menu, it should be displayed only the entire second row inlcuding the column names.
library(shiny)
Values <- data.frame(A = 1:3, B = letters[24:26], C = 11:13)
shinyApp(
ui = fluidPage(
sidebarPanel(
selectInput("Values", "Values", Values$B),
mainPanel(
tableOutput("ValuesTable")
)
)
),
server = function(input, output) {
output$ValuesTable <- renderTable({
Values
})
})
What I´ve found so far are solutions with _rows_selected. However, it doesn´t fit to my problem or I´m not able to make use of it, yet.
You can filter values in the appropriate column using dplyr::filter() with your select input "Values" in the renderTable() function.
library(shiny)
library(dplyr) # for filter() function
library(magrittr) # for pipe operator
Values <- data.frame(A = 1:3, B = letters[24:26], C = 11:13)
shinyApp(
ui = fluidPage(
sidebarPanel(
selectInput("Values", "Values", Values$B),
mainPanel(
tableOutput("ValuesTable")
)
)
),
server = function(input, output) {
output$ValuesTable <- renderTable({
Values %>%
dplyr::filter(B == input$Values)
})
})
Related
I am quite new to R shiny and I am trying to build a small shiny app but I don't know where I went wrong.
I am trying to get multiple user input via text area to filter my table output. Moreover, i want to control the columns to show in the table as well. Code is running fine for showing the columns but it is working only with one input value in the text area, it is not working with multiple user inputs.
I want to filter the table output with multiple user inputs as well.
For example for this code snippet it should return table when I write "honda,audi,bmw" in the text area input.
library(shiny)
library(shinyWidgets)
library(DT)
df <-mtcars
#ui
shinyApp(
ui = fluidPage(
titlePanel("Trial 1"),
sidebarLayout(
sidebarPanel(
#to take multiple user input
textAreaInput(
"text_input",
label = "Write multiple input separated by comma"
),
#to slect the columns to be added
pickerInput(
inputId = "somevalue",
label = "Columns to add",
choices = colnames(df),
options = list(`actions-box` = TRUE),
multiple = TRUE
),
#action button tot show the table
actionBttn(
"show_table",
label = "Show",
size = "sm",
color = "default",
block = TRUE
),
),
mainPanel(
tabsetPanel(type = "tabs",
tabPanel("Table", DT::dataTableOutput("table")),
tabPanel("Summary", verbatimTextOutput("summary"))
)
)
)
),
server = function(input, output,session) {
data <- observeEvent(input$show_table,{
text_input <- trimws(strsplit(input$text_input, ",")[[1]])
output$summary <- renderPrint({
summary(data())
})
output$table <- DT::renderDT({
df_sub <- df[df$make %chin% input$text_input, input$somevalue]
#df_sub = df[ ,input$somevalue]
datatable(df_sub,
caption = "PLease enter the changes by double clicking the cell",
editable = 'cell')
})
})
}
)
There isn't a 'make' variable in the data. I guess you refer to the first word of the row name as the make of the car. Then the strings you entered could be matched with the make of the car.
server = function(input, output,session) {
data <- observeEvent(input$show_table,{
brand <- word(rownames(df), 1)
text_input <- strsplit(input$text_input, ",")[[1]]
df_sub <- df[brand %in% text_input, input$somevalue]
output$summary <- renderPrint({
summary(df_sub)
})
output$table <- DT::renderDT({
datatable(df_sub,
caption = "PLease enter the changes by double clicking the cell",
editable = 'cell')
})
output$test <- renderText({
text_input
})
})}
I have a vector with sequence of elements. I'm trying to provide two selectInput for the user to choose elements/variables from the vector, such that the element selected in the first is excluded from second selectInput.
I tried to remove the selected element based on index from the sequence of second selectInput, but the output was only one element, instead of all the remaining list of elements.
I couldn't understand why. Can someone help me?
Thank you in advance.
Below is the code:
data <- c("cultivar","control", "stress")
ui <- fluidPage(
selectInput("select1", "Select variable", choices = data),
uiOutput("UiSelect2")
)
server <- function(input, output, session) {
output$UiSelect2 <- renderUI({
#remove the selected element based on index
newData <- data[-which(data == input$select1)]
selectInput("select2","Select another variable", choices= ifelse(isTruthy(input$select1), newData, data))
})
}
shinyApp(ui, server)
Is this what you want?
library(shiny)
data <- c("cultivar","control", "stress")
ui <- fluidPage(
selectInput("select1", "Select variable", choices = data),
uiOutput("UiSelect2")
)
server <- function(input, output, session) {
output$UiSelect2 <- renderUI({
#remove the selected element based on index
newData <- data[!data %in%input$select1]
selectInput("select2","Select another variable", choices = newData)
})
}
shinyApp(ui, server)
The code below reads a CSV file and displays the Datatable in the Main panel. The field in 'Column to search' is automatically detected. I've created a field named 'Replace' and a field called 'by' that can be used to replace certain values in a column's cell.
I want to highlight that cell in any colour, preferably orange, wherever the values are replaced.
Could someone please explain how I can do this in R shiny?
CSV
ID Type Category values
21 A1 B1 030,066,008,030,066,008
22 C1 D1 020,030,075,080,095,100
23 E1 F1 030,085,095,060,201,030
Expected Output:
If I change 030 to 100 in the columns 'values,' I want that cell (in column Values and Row 2) to be coloured.
code
library(shiny)
library(DT)
library(stringr)
library(dplyr)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
fileInput("file1", "Choose CSV File", accept = ".csv"),
checkboxInput("header", "Header", TRUE),
selectInput("col", "Column to search:", NULL),
textInput("old", "Replace:"),
textInput("new", "By:"),
actionButton("replace", "Replace!"),
),
mainPanel(
DTOutput("table1")
)
)
)
server <- function(input, output, session) {
my_data <- reactiveVal(NULL)
observeEvent(input$file1, {
file <- input$file1
ext <- tools::file_ext(file$datapath)
req(file)
# validate(need(ext == "csv", "Please upload a csv file"))
my_data(read.csv2(file$datapath, header = input$header))
updateSelectInput(session, "col", choices = names(my_data()))
})
observeEvent(input$replace, {
req(input$col)
dat <- req(my_data())
traf <- if (is.numeric(dat[[input$col]])) as.numeric else identity
my_data(dat %>%
mutate(!!rlang::sym(input$col) :=
stringr::str_replace_all(!!rlang::sym(input$col),
input$old,
input$new) %>%
traf()))
})
output$table1 <- renderDT(
req(my_data())
)
}
shinyApp(ui, server)
I thought of a possible workaround that consists in using DT::formatStyle() to color each modified cell. One drawback of using this approach is that the csv imported will have twice as many columns (because i will need them to tell formatStyle() in which cells it has to add colors). However, the additional cols can be hidden so they don't appear displayed, but they will be present in the object passed to datatable. The additional columns are required if the cells need to stay colored after each edit, if that's not the case, then one extra column will suffice. Notice that the good news is that only R code is used here.
The first step will be to create the additional columns, so after the .csv file is read into reactive my_data():
#create (n = number of columns) reactive values.
nms <- vector('list', ncol(my_data())) %>% set_names(names(my_data()))
ccol <<- exec("reactiveValues", !!!nms)
#pre-allocate all the columns that we're going to use.
my_data(map_dfc(names(ccol), ~transmute(my_data(), 'orange_{.x}' := 0)) %>% {bind_cols(my_data(), .)})
Now, each time a column is modified somewhere, the corresponding orange_colname will contain a boolean indicated if a modification took place.
ccol[[input$col]] <- str_detect(dat[[input$col]], input$old)
my_data(my_data() %>%
mutate('orange_{input$col}' := ccol[[input$col]]))
finally, we render the table using datatable()'s option argument to hide the extra cols, and then use a for loop to add the colors in each column. I need to use a loop here because the app can import any table really as long it is a data frame.
Dtable <-
datatable(my_data(),
options = list(columnDefs = list(list(visible = FALSE, targets = (ncol(my_data())):((ncol(my_data()) / 2) + 1) ))))
walk(names(ccol), ~ { Dtable <<- Dtable %>% formatStyle(..1, str_glue("orange_{.x}"),
backgroundColor = styleEqual(c(1), c("orange"))) })
Dtable
App:
library(shiny)
library(DT)
library(stringr)
library(tidyverse)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
fileInput("file1", "Choose CSV File", accept = ".csv"),
checkboxInput("header", "Header", TRUE),
selectInput("col", "Column to search:", NULL),
textInput("old", "Replace:"),
textInput("new", "By:"),
actionButton("replace", "Replace!"),
),
mainPanel(
DTOutput("table1")
)
)
)
server <- function(input, output, session) {
my_data <- reactiveVal(NULL)
last_coloured <- reactiveVal(NULL)
observeEvent(input$file1, {
file <- input$file1
ext <- tools::file_ext(file$datapath)
req(file)
# validate(need(ext == "csv", "Please upload a csv file"))
my_data(read_csv(file$datapath))
updateSelectInput(session, "col", choices = names(my_data()))
#create (n = number of columns) reactive values.
nms <- vector('list', ncol(my_data())) %>% set_names(names(my_data()))
ccol <<- exec("reactiveValues", !!!nms)
#pre-allocate all the columns that we're going to use.
my_data(map_dfc(names(ccol), ~transmute(my_data(), 'orange_{.x}' := 0)) %>% {bind_cols(my_data(), .)})
})
observeEvent(input$replace, {
req(input$col)
dat <- req(my_data())
traf <- if (is.numeric(dat[[input$col]])) as.numeric else identity
my_data(dat %>%
mutate(!!rlang::sym(input$col) :=
stringr::str_replace_all(
!!rlang::sym(input$col),
input$old,
input$new
) %>%
traf()))
# also i would like to know which rows are modified
ccol[[input$col]] <- str_detect(dat[[input$col]], input$old)
my_data(my_data() %>%
mutate('orange_{input$col}' := ccol[[input$col]]))
})
output$table1 <- renderDT({
req(my_data())
Dtable <-
datatable(my_data(),
options = list(columnDefs = list(list(visible = FALSE, targets = (ncol(my_data())):((ncol(my_data()) / 2) + 1) ))))
walk(names(ccol), ~ { Dtable <<- Dtable %>% formatStyle(..1, str_glue("orange_{.x}"),
backgroundColor = styleEqual(c(1), c("orange"))) })
Dtable
})
}
shinyApp(ui, server)
I used the parameter selection from renderDT(). After changing my_data(), you can compare which positions were changed in relation with dat (where you stored the unchanged data.frame) and then pass them as coordinates to the selection parameter
server <- function(input, output, session) {
my_data <- reactiveVal(NULL)
positions <- reactiveVal(NULL) ## here we'll save positions of changed cells
observeEvent(input$file1, {
file <- input$file1
ext <- tools::file_ext(file$datapath)
req(file)
# validate(need(ext == "csv", "Please upload a csv file"))
my_data(read.csv2(file$datapath, sep = ",", header = input$header))
updateSelectInput(session, "col", choices = names(my_data()))
})
observeEvent(input$replace, {
req(input$col, my_data())
dat<- my_data()
traf <- if (is.numeric(dat[[input$col]])) as.numeric else identity
my_data(dat %>%
mutate(!!rlang::sym(input$col) :=
stringr::str_replace_all(!!rlang::sym(input$col),
input$old,
input$new) %>%
traf()))
positions(which(dat != my_data(), arr.ind = T)) # this is where new
# values positions are stored
})
output$table1 <- renderDT({
req(my_data())
}, selection=list(mode="single",##### this argument let you select a cell
target="cell",
selected = positions()))
}
If you set input$old to "030", all cells will be selected, since "030" is present in all 3 cells. But if you do it with "066", you'll see only the first cell of "values" will be highlighted
I would like to update column headers in an R Shiny proxy table. The app should:
Launch with original column header names (e.g. "Do","Re","Mi","Fa","So")
Change those column headers in the proxy table to something else when the user clicks an action button (e.g. "y1","y2","y3","y4","y5")
Shiny has a convenient updateCaption() method that allows for a similar behavior for proxy table captions. I'd like to do something similar with table column headers for proxy tables. Here's my attempt.
library(shiny)
library(DT)
ui <- fluidPage(
fluidRow(
actionButton(
"updatebutton",
label = "Update Table",
style = "margin-right: 5px;"
),
DT::dataTableOutput("myplot")
),
)
server <- function(input, output) {
mycolumnnames <-c("Do","Re","Mi","Fa","So")
myothercolumnnames <- c("y1","y2","y3","y4","y5")
output$myplot <- DT::renderDataTable({
DF <- data.frame(replicate(5, sample(rnorm(5), 10, rep = TRUE)))
datatable(DF, colnames = mycolumnnames,
caption="Original caption")
})
proxy <- DT::dataTableProxy("myplot")
observeEvent(input$updatebutton, {
updateCaption(proxy, caption="Look, I am a NEW caption!")
DF <- data.frame(replicate(5, sample(rnorm(5), 10, rep = TRUE)))
# names(DF) <- myothercolumnnames # This doesn't work
proxy %>% replaceData(DF)
})
}
shinyApp(ui = ui, server = server)
Edit1: Now uses dataTableProxy()
I took away all the things related to color background so I could focus on your problem.
First, I declare some values outside shiny: your data.frame and two vectors for the column names. Then I assign the column names as the first vector.
Inside the app, I retrieve the data as a reactiveVal(), and update its colnames whenever the button is pressed
library(shiny)
library(DT)
mycolumnnames <-c("Do","Re","Mi","Fa","So")
myothercolumnnames <- c("y1","y2","y3","y4","y5")
DF <- data.frame(replicate(5, sample(rnorm(5), 10, rep = TRUE)))
colnames(DF) <- mycolumnnames
ui <- fluidPage(
fluidRow(
actionButton(
"updatebutton",
label = "Update Table",
style = "margin-right: 5px;"
),
DT::dataTableOutput("myplot")
),
)
server <- function(input, output) {
df <- reactiveVal(DF)
output$myplot <- DT::renderDataTable({
datatable(df(), caption="Original caption")
})
observeEvent(input$updatebutton, {
new_data <- data.frame(replicate(5, sample(rnorm(5), 10, rep = TRUE)))
if(!input$updatebutton %% 2 == 0 ){
colnames(new_data) <- myothercolumnnames
} else {
colnames(new_data) <- mycolumnnames
}
df(new_data)
proxy1 <- DT::dataTableProxy("myplot")
updateCaption(proxy1, caption="Look, I am a NEW caption!")
replaceData(proxy1, df())
})
}
shinyApp(ui = ui, server = server)
So whenever you press the button, the colnames are changed between the two vectors.
I am attempting to run a regression that allows users to determine regression inputs, and then provide an output that is the regression summary. For whatever reason, the output is not coming out correct, and I have looked everyone on the internet to find a solution. I am hoping somebody can help.
For clarification, this is in shiny.
Here is my server code:
shinyServer(
function(input,output,session) {
mod <- eventReactive(input$analysis,{
response <- data[,2]
explan1 <- data[,input$Explan1]
explan2 <- data[,input$Explan2]
explan3 <- data[,input$Explan3]
mod1 <- lm(response~explan1+explan2+explan3)
} )
output$modelSummary <- renderPrint({
(summary(mod()$mod1))
})
output$ColumnNames <- renderPrint({
as.data.frame(colnames(data))
})
}
)
summary(model)
And my ui code
shinyUI(
fluidPage(
titlePanel("What does it take for a Hockey Team to Win?"),
titlePanel("Please select the column numbers for three variables to regress on"),
sidebarLayout(
sidebarPanel(
verbatimTextOutput("ColumnNames"),
numericInput("Explan1","Explanatory Variable 1",3,min = 3, max = 13),
numericInput("Explan2","Explanatory Variable 2",4,min = 3,max = 13),
numericInput("Explan3","Explanatory Variable 3",5,min = 3, max = 13)
),
mainPanel(
actionButton("analysis","Analyze!"),
verbatimTextOutput("modelSummary")
)
)
)
)
When I run the app, select the input columns (which are by number rather than name. I hope to fix this later) and click analyze, I get the following output:
Length Class Mode
0 NULL NULL
I haven't been able to find much relevant information on this output. I hope you all can help.
Thank you in advance.
You're just calling the reactive incorrectly, it should be: summary(mod()) instead of summary(mod()$mod1). Reactives behave very much like functions the way that they return objects.
Here is a fully reproducible example, with an example on how to use a formula instead of individually selecting the columns:
col_names <- names(mtcars)
ui <- fluidPage(
sidebarPanel(
verbatimTextOutput("ColumnNames"),
selectInput("Response", "Response Variable", choices = col_names, selected = "mpg"),
selectInput("Explan1","Explanatory Variable 1", choices = col_names, selected = "cyl"),
selectInput("Explan2","Explanatory Variable 2", choices = col_names, selected = "disp"),
selectInput("Explan3","Explanatory Variable 3", choices = col_names, selected = "wt")
),
mainPanel(
actionButton("analysis","Analyze!"),
verbatimTextOutput("modelFormula"),
verbatimTextOutput("modelSummary")
)
)
server <- function(input, output, session) {
myformula <- reactive({
expln <- paste(c(input$Explan1, input$Explan2, input$Explan3), collapse = "+")
as.formula(paste(input$Response, " ~ ", expln))
})
mod <- eventReactive(input$analysis, {
lm(myformula(), data = mtcars)
})
output$modelFormula <- renderPrint({
myformula()
})
output$modelSummary <- renderPrint({
summary(mod())
})
}
shinyApp(ui, server)
Screenshot: