I want to delete a selected variable from the dataset in R shinydashboard. Please find attached my code. But when I try to select a variable and delete,
if(input$imputation == "Delete Variable"){
rv$Train <- rv$Train[,-(input$miss_var)]
return(rv$Train)
}
I get the following error,
Warning: Error in -: invalid argument to unary operator
UI
Please find the ui part of the code,
library(shiny)
library(shinydashboard)
library(missForest)
ui <- dashboardPage(skin = "black",
dashboardHeader(title = "Analytics Workbench 2.0", titleWidth = 250, dropdownMenuOutput("msgs")),
dashboardSidebar(
sidebarMenu(
fileInput("Table1", "Historical Data"),
radioButtons("sep", "Separator", choices = c(Comma = ",", Semicolon = ";", Tab = "\t", Pipe="|"), selected = ","),
menuItem("Variable Transformation", tabName = "transformation",icon = icon("exchange")))),
dashboardBody(
tabItems(
tabItem(tabName = "transformation",
fluidRow(
box(selectInput("miss_var", "Variable", c("1"="1","2"="2")), width = 2, status = "primary"),
box(title = "Missing Value Imputation", width = 4, status = "primary", solidHeader = TRUE, collapsible = TRUE,
radioButtons("imputation", label = "",
choices = list(Delete_Variable = "Delete Variable", Impute = "Impute"), selected = ""),
actionButton("miss_imp", "Select"))))
)
)
)
SERVER
Please find the server part of the code,
server <- function(input, output, session) {
## initialize
rv <- reactiveValues()
## update when dataset changes
observe({
rv$Train <- read.table(req(input$Table1)$datapath, fill = TRUE, header=T,
sep=input$sep, na.strings = c(""," ",NA),
stringsAsFactors = TRUE)
})
observe({
is.miss <- sapply(rv$Train, function(y) sum(length(which(is.na(y)))))
dname3 <- names(rv$Train[, is.miss > 0])
col_options3 <- list()
col_options3[dname3] <- dname3
updateSelectInput(session, "miss_var",
label = "Missing Variables",
choices = col_options3,
selected = "")
})
observeEvent(input$miss_imp,{
if(input$imputation == "Delete Variable"){
rv$Train <- rv$Train[,-(input$miss_var)]
return(rv$Train)
} else if(input$imputation == "Impute"){
missfor <- missForest(rv$Train)
rv$Train <- data.frame(missfor$ximp)
return(rv$Train)
}
})
}
shinyApp(ui, server)
Thanks,
Balaji
Related
I am a newbie to shiny dashboard. I want to know how to print str() of the table which i have imported in shiny dashboard. my code is not working. When i print str(), i get the below output,
str()
Please check the code which i have written,
library(shiny)
library(shinydashboard)
library(DT)
ui <- dashboardPage(
dashboardHeader(title = "Analytics Workbench 2.0", titleWidth = 250,
dropdownMenuOutput("msgs")),
dashboardSidebar(
sidebarMenu(
fileInput("Table1", "Train Data"),
fileInput("Table2", "Test Data"),
menuItem("Variable Analysis", icon = icon("edit"),
menuSubItem("Uni-Variate Analysis"),
menuSubItem("Multi-Variate Analysis"))
)
),
dashboardBody(
fluidRow(
column(12, box(title = "Train Data", width = 6, solidHeader = TRUE, status = "warning",
collapsible = TRUE, DT::DTOutput("Train")),
box(title = "Test Data", width = 6, solidHeader = TRUE, status = "warning",
collapsible = TRUE, DT::DTOutput("Test")))),
fluidRow(
column(12, box(title = "Structure", width = 6, solidHeader = TRUE, status = "warning",
collapsible = TRUE, verbatimTextOutput("str1")),
box(title = "Structure", width = 6, solidHeader = TRUE, status = "warning",
collapsible = TRUE, verbatimTextOutput("str2"))))
)
)
server <- function(input, output) {
output$msgs <- renderMenu({
msg <- apply(read.csv("messages.csv"), 1, function(row){
messageItem(from = row[["from"]], message = row[["message"]]) })
dropdownMenu(type = "messages", .list = msg)
})
output$Train <- DT::renderDT({
if (is.null(input$Table1)) return(NULL)
data1 <- read.table(input$Table1$datapath, fill = TRUE, header=T, sep=",")
DT::datatable(data1, options = list(scrollX = TRUE))
})
output$Test <- DT::renderDT({
if (is.null(input$Table2)) return(NULL)
data2 <- read.table(input$Table2$datapath, fill = TRUE, header=T, sep=",")
DT::datatable(data2, options = list(scrollX = TRUE))
})
output$str1 <- renderText({
paste(capture.output(str(input$Table1)), collapse = "\n")
})
output$str2 <- renderText({
paste(capture.output(str(input$Table1)), collapse = "\n")
})
}
I am not able to find out the input to be given for str()
Thanks
Balaji
Switch out your textOutput for verbatimTextOutput. Also, you require a reactive to treat the fileInput... specifically take note that you should trap the case when the input value is NULL.
app.R
library(shiny)
write.csv(mtcars, "mtcars.csv") # file created to test file input
ui <- fluidPage(
mainPanel(
verbatimTextOutput("strfile"),
fileInput("file1", "File")
)
)
server <- function(input, output) {
df <- reactive({
if (is.null(input$file1)) {
return(NULL)
} else {
read.csv(input$file1$datapath, row.names = 1) # note the row.names are dependent on your input requirements
}
})
output$strfile <- renderPrint({str(df())})
}
shinyApp(ui = ui, server = server)
To get this output...
The process_map() function in the server in the R shiny script creates the diagram image as below. My requirement is that there are two attributes "FUN" and "units" that are part of the performance() function. They have standard four values each that are available in the ui code below under PickerInput ID's Case4 and Case5. Currently, I am hard coding the value to create the map, can you help me to use the id's in the server code and make it dynamic such that when I select the value in the PickerInput, the formula fetches the value directly. Thanks and please help.
library(shiny)
library(shinydashboard)
library(bupaR)
library(processmapR)
library(lubridate)
library(dplyr)
library(edeaR)
library(shinyWidgets)
library(DiagrammeR)
ui <- dashboardPage(
dashboardHeader(title = "Diagram Plot",titleWidth = 290),
dashboardSidebar(width = 0),
dashboardBody(
tabsetPanel(type = "tab",
tabPanel("Overview", value = 1,
box(
column(1,
dropdown(
pickerInput(inputId = "resources",
label = "",
choices = c("Throughput Time"),
choicesOpt = list(icon = c("fa fa-bars",
"fa fa-bars",
"fa fa-safari")),
options = list(`icon-base` = "")),
circle = FALSE, status = "primary", icon = icon("list", lib = "glyphicon"), width = "300px"
),
conditionalPanel(
condition = "input.resources == 'Throughput Time' ",
tags$br(),
tags$br(),
tags$br(),
dropdown(
pickerInput(inputId = "Case4",
label = "Select the Process Time Summary Unit",
choices = c("min","max","mean","median"), options = list(`actions-box` = TRUE),
multiple = F),
circle = FALSE, status = "primary", icon = icon("eye-close", lib = "glyphicon"), width = "300px"
),
tags$br(),
tags$br(),
tags$br(),
dropdown(
pickerInput(inputId = "Case5",
label = "Select the Process Time Unit",
choices = c("mins","hours","days","weeks"), options = list(`actions-box` = TRUE),
multiple = F, selected = "days"),
circle = FALSE, status = "primary", icon = icon("eye-close", lib = "glyphicon"), width = "300px"
))),
title = "Process Map",
status = "primary",height = "575", width = "500",
solidHeader = T,
column(10,grVizOutput("State")),
align = "left")
),
id= "tabselected"
)))
server <- function(input, output) {
output$State <- renderDiagrammeR(
{
if(input$resources == "Throughput Time")
patients %>% process_map(performance(FUN = mean,units = "days"))
else
return()
})}
shinyApp(ui, server)
test this:
output$State <- renderDiagrammeR({
if(input$resources == "Throughput Time")
{
if(input$Case4=="mean"){
patients %>% process_map(performance(FUN = mean,units = input$Case5))}
else if(input$case4=="min"){
patients %>% process_map(performance(FUN = min,units = input$Case5))
}else if(input$case4=="max"){
patients %>% process_map(performance(FUN = max ,units = input$Case5))
}else{
patients %>% process_map(performance(FUN = median ,units = input$Case5))
}
}else
return()
})
or you can use this:
patients %>%
process_map(performance(FUN = eval(parse(text=input$Case4)) ,units = input$Case5))
enjoy;)
here is a sample:
library(shiny)
ui <- fluidPage(
selectInput(inputId = "func", label = "Choose The Function", choices = c("mean", "sum", "median"))
,
textOutput("text")
)
server <- function(input, output, session) {
main_data <- reactive({
data.frame(a= rnorm(100), b=rnorm(100) )
})
output$text <- renderText({
df <- main_data()
apply(df,2, FUN = eval(parse(text=input$func)) )
})
}
shinyApp(ui = ui, server = server)
You could use do.call to call a function from its name, see the example below. You can add arguments by adding them in the list in the do.call function, e.g. list(x,units=input$Case5).
library(shiny)
x=c(1,2,3,4,5,6,7)
ui <- fluidPage(
selectInput('select','Select Function: ', choices=c('mean','max','min','median')),
textOutput('text')
)
server <- function(input,output)
{
output$text <- renderText({
result = do.call(input$select, list(x))
paste0('The ', input$select, ' of [', paste(x,collapse=', '),'] is ', result)
})
}
shinyApp(ui,server)
Hope this helps!
I am working on a Shiny App that uses rhandsontable and I would like to provide the user an option to save and load the progress. A minimal example of my code is as follows:
library(shinydashboard)
library(shiny)
library(data.table)
library(rhandsontable)
library(markdown)
sidebar <- dashboardSidebar(
sidebarMenu(
menuItem("Data", tabName = "data", icon = icon("file")),
menuItem("Control", tabName = "control", icon = icon("list-alt"))
)
)
body <- dashboardBody(
tabItems(
tabItem(tabName = "data",
fluidRow(
box(title = h3("Input data manually or by importing a .csv file:"),
#fileInput("file1", "Choose CSV File:", width = '30%',
# multiple = TRUE,
# accept = c("text/csv",
# "text/comma-separated-values,text/plain",
# ".csv")),
width = 12, height = 800, rHandsontableOutput("hot"))
)
),
tabItem(tabName = "control",
fluidRow(
actionButton("save", "Save"), actionButton("load", "Load"),
box(title = h2("1. General Information"), width = '100%',
radioButtons("Type",
h4("Type:"),
choices = list("1" = "1", "2" = "2")),
radioButtons("DataExtraction",
h4("Extract information:"),
choices = list("Yes" = "Yes", "No" = "No"), selected = "No")
)
)
)
)
)
ui <- dashboardPage(
dashboardHeader(title = "Shiny"),
sidebar,
body
)
server <- function(input, output, session) {
observeEvent(input$load,{
values <<- readRDS("C:/Documents/ws1.RData")
if (exists("values")) {
lapply(names(values),
function(x) session$sendInputMessage(x, list(value = values[[x]]))
)
}
})
observeEvent(input$save,{
values <<- lapply(reactiveValuesToList(input), unclass)
saveRDS( values , file = "C:/Documents/ws1.RData")
})
filedata <- reactive({
inFile <- input$file1
if (is.null(inFile)){
data.table(Number1 = numeric(20),
Number2 = numeric(20),
Date1 = seq(from = Sys.Date(), by = "days", length.out = 20),
Date2 = seq(from = Sys.Date(), by = "days", length.out = 20))
} else{
fread(input$file1$datapath)
}
})
output$hot = renderRHandsontable({
rhandsontable(filedata()) %>%
hot_cols(columnSorting = TRUE) %>%
hot_table(highlightCol = TRUE, highlightRow = TRUE)
})
}
shinyApp(ui, server)
I am encountering two issues:
When I include the fileInput("file1", ...), the inputs do not update
anymore once I click the load action button;
The Rhandsontable is not updated. However, when I look into values$hot$data, it does seem as if the data is properly stored in values.
Does anyone have an idea of what I am doing wrong?
Thanks!
I have solved this programmed but while changing input I am unable to find output change as a table please any one can help me using R shiny code
I have solve the error but it's still showing only
library(shiny)
library(DT)
bcl <- read.csv("R-D.csv", stringsAsFactors = FALSE)
ui <- shinyUI(fluidPage(
sidebarLayout(
sidebarPanel(
radioButtons("TYPE.OF.DATA","View data by:", choices = c("NP", "CR", "AN"), inline = TRUE, selected = "NP"),
tags$hr(),
radioButtons(" LINE.OF.BUSINESS ","View data by:" ,choices = c("AF", "HL"), inline = TRUE, selected = "AF"),
tags$hr(),
selectInput("typeInput6", " APPLICATION ",
choices = c("TERADATA"),
selected = "TERADATA"),
tags$hr(),
radioButtons( "DatabaseName","View data by:",choices = c("DW_re", "DW_np", "DW_AN"), inline = TRUE, selected = "DW_re")
),
mainPanel(
DT::dataTableOutput("table")
)
)
))
server <- shinyServer(function(input, output,session) {
observe({
if(input$bcl == "TYPE.OF.DATA"){
choices = c("NP", "CR", "AN")
firstchoice = "NP"
label = "DATA TYPE:"
}else{
choices = c("DW_re", "DW_np", "DW_AN")
firstchoice = "DW_re"
label = "NAME:"
}
updateSelectInput(session, "bcl", label = label, choices = choices, selected = firstchoice)
})
data <- reactive({
data = switch(input$bcl,
"NP" = NP, "CR" = CR, "AN" = AN,
"DW_re" = DW_re, "DW_np" = DW_np, "DW_AN" = DW_AN
)
})
output$table <- DT::renderDataTable({
datatable(data())
})
})
shinyApp(ui=ui,server=server)
I want to implement a function in a Shiny app. My own function get_calculate() has the arguments data and tolerance as input and retruns a list with a data.frame and a plot.
I want to show the output depending on tolerance. In my server function I use reactive() to run get_calculate() but it doesn't work.
If I write in renderPlot() and renderDataTable() get_calculate() works.
For large datasets, however, it's inefficient because Shiny will have to run get_calculate() twice.
library(shiny)
library(shinydashboard)
library(foreign)
#load my own function
source("01-get_calculate.R")
ui <- dashboardPage(
dashboardHeader(title = "Analysis"),
dashboardSidebar(
sidebarMenu(
menuItem("Load data", tabName = "data", icon = icon("database")),
menuItem("Mainboard", tabName = "Mainboard", icon = icon("dashboard"))
)
),
dashboardBody(
tabItems(
tabItem(tabName = "data",
fileInput("datafile", "Choose file",
accept = c("text/csv/rds/dbf", 'text/comma-separated-values,text/plain')),
dataTableOutput("mytable")
),
tabItem(tabName = "Mainboard",
fluidRow(
box(
title = "Input", status = "primary", solidHeader = TRUE, collapsible = TRUE,
sliderInput(inputId = "tol",
label = "Tolerance",
value = 4, min = 1, max = 15, step = 1)
)),
fluidRow(
box(
title = "Adherence Curve", status = "warning", solidHeader = TRUE, collapsible = TRUE,
plotOutput("plot_kpm")
),
box(
title = "Overview Table", status = "primary", solidHeader = TRUE, collapsible = TRUE,
tableOutput("table_kpm")
)
)
)
)
)
)
server <- function(input, output) {
filedata <- reactive({
infile <- input$datafile
if (is.null(infile)) {
return(NULL)
}
read.dbf(infile$datapath)
})
output$mytable <- renderDataTable({
filedata()
})
**test <- reactive({
get_calculate(filedata(), tolerance = input$tol)
})
output$plot_kpm <- renderPlot({
test$kpm_chart
})
output$table_kpm <- renderDataTable({
test$data_kpm[, c("Time", "numbers", "Percent")]
})**
}
shinyApp(ui = ui, server = server)
The error you mentioned is most likely from renderDataTable where you are trying to pick couple of columns from test$data_kpm. Check the dataframe for exact column names.
This version of my shiny app runs. But it' ineffcient because shiny have to runs get_calculate twice.
server <- function(input, output) {
#This function is repsonsible for loading in the selected file
filedata <- reactive({
infile <- input$datafile
if (is.null(infile)) {
# User has not uploaded a file yet
return(NULL)
}
read.dbf(infile$datapath)
})
output$mytable <- renderDataTable({
filedata()
})
output$plot_kpm <- renderPlot({
get_calculate(filedata(), tolerance = input$tol)$kpm_chart
})
output$table_kpm <- renderTable({
get_calculate(filedata(), tolerance = input$tol)$data_kpm[, c("Time", "Percent", "Patients")]
})
output$download_mainboard_adherence_table <- downloadHandler(
filename = paste("adherence_table", '.csv', sep=''),
content = function(file) {
write.csv(get_calculate(filedata(), tolerance = input$tol)$data_kpm[, c("Time", "Percent", "Patients")], file)
}
)
}
Why don't you use a reactive expression to run your get_calculate just once ? And then use the result in your output$plot_kpm and output$table_kpm ?
This will optimize your code.