Related
I have a dataframe:
df1<-data.frame(a=rnorm(100),b=rnorm(100),c=rnorm(100),ID1=c("A","B"),ID2=(c("A","B","C","D")))
I am drawing a 3d plot with plotly by adding add_trace in a loop, like:
library(shiny)
library(plotly)
library(tidyverse)
df1<-data.frame(a=rnorm(100),b=rnorm(100),c=rnorm(100),ID1=c("A","B"),ID2=(c("A","B","C","D")))
test<-unique(df1$ID2)
tempt.col<-c("red","blue","green","yellow")
p<-plot_ly()
for(i in 1:length(test)){
df2<-df1[df1$ID2==test[i],] %>%
select(a,b,c)
p<-add_trace(p=p,
data = df2,
x=~a,y=~b,z=~c,
type="scatter3d",
marker = list(size=5,color=tempt.col[i]),
mode="markers"
)
}
p
It works very well like:
Now I want to achieve this in shiny, I would like to generate colourInput based on the length of the selected ID, the ui:
ui<-fluidPage(
fluidRow(
sidebarPanel(
selectInput("select1","Select the ID",choices = colnames(df1[,4:5]),multiple = FALSE),
actionButton("act1","Go"),
uiOutput("ui1"),
),
mainPanel(
tableOutput("table1"),
plotlyOutput("plot.3d",height = "1000px")
)
)
)
server:
server<-function(input,output){
tempt.group<-reactive({
unique(df1[,input$select1])
})
observeEvent(input$act1,{
tempt.vector<-list()
tempt.col.name<-isolate(
vector(mode = "list",length = 2)
)
for(i in 1:length(tempt.group())){
tempt.vector[[i]]<-colourpicker::colourInput(
inputId = paste0("ColorID",i),
label = tempt.group()[i])
tempt.col.name[[1]][i]<-paste0("ColorID",i)
tempt.col.name[[2]][i]<-tempt.group()[i]
}
output$ui1<-renderUI({
tempt.vector
})
names(tempt.col.name)<-c("inputId","label")
col.name<-reactive({
data.frame(sapply(tempt.col.name,cbind))
})
col.df<-reactive({
tempt.col.df<-reactiveValuesToList(input)
data.frame(
names = names(tempt.col.df[grepl("ColorID", names(tempt.col.df))]),
values = unlist(tempt.col.df[grepl("ColorID", names(tempt.col.df))], use.names = FALSE)
)
})
group.col.df<-reactive({
merge(col.df(),col.name(),by.x="names",by.y="inputId")
})
output$table1<-renderTable(
group.col.df()
)
pp<-reactive({
p<-plot_ly()
for(i in 1:length(tempt.group())){
# col<-group.col.df()[group.col.df()[,"label"]==tempt.group()[i],"values"] ####it should be something wrong with here
df2<-df1[df1$ID==tempt.group()[i],] %>%
select(a,b,c)
p<-add_trace(p=p,
data = df2,
x=~a,y=~b,z=~c,
type="scatter3d",
# marker = list(size=5,color=col[i]), ####it should be something wrong with here
mode="markers"
)
}
p
})
output$plot.3d<-renderPlotly({
pp()
})
})
}
shinyApp(ui=ui,server=server)
The app is like:
I want to fetch the colourInput and pass to the color of the 3d scatter plot, but nothing works. The page either keeps refreshing or frozen,
That must be something wrong with col<-group.col.df()[group.col.df()[,"label"]==tempt.group()[i],"values"] and marker = list(size=5,color=col[i]),
please help.
The below works as intended.
library(shiny)
library(plotly)
df1<-data.frame(a=rnorm(100),b=rnorm(100),c=rnorm(100),ID1=c("A","B"),ID2=(c("A","B","C","D")))
# Define UI
ui<-fluidPage(
fluidRow(
sidebarPanel(
selectInput("select1","Select the ID",choices = colnames(df1[,4:5]),multiple = FALSE),
# actionButton("act1","Go"),
uiOutput("myui"),
# keep track of the last selection on all selectInput created dynamically
),
mainPanel(
#tableOutput("table1"),
plotlyOutput("plot.3d",height = "1000px")
)
)
)
# Define server logic required to draw a histogram
server<-function(input,output){
rv <- reactiveValues(mygroup=0, uitaglist = list(), uilabels = list(), input_subset = list(), plotly=NULL)
observeEvent(input$select1, {
newgroup <- unique(df1[,input$select1])
rv$mygroup <- newgroup
# ui tags
rv$uitaglist <- list()
for(i in 1:length(rv$mygroup)){
rv$uitaglist[[i]]<-colourpicker::colourInput(
inputId = paste0("ColorID",i),
label = rv$mygroup[i])
rv$uilabels[[i]] <- paste0("ColorID",i)
}
})
output$myui <- renderUI({
rv$input_subset <- rv$uitaglist
})
observe({
rv$input_subset <- lapply(rv$uilabels, function(x) input[[x]])
p<-plot_ly()
for(i in 1:length(rv$mygroup)) {
df2<-df1[df1$ID2 == rv$mygroup[i],] %>% select(a,b,c)
p<-add_trace(p=p,
data = df2,
x=~a,y=~b,z=~c,
type="scatter3d",
marker = list(size=5,color=rv$input_subset[[i]]),
mode="markers"
)
}
rv$plotly <- p
})
output$plot.3d<-renderPlotly({
rv$plotly
})
} # end server
# Run the application
shinyApp(ui = ui, server = server)
The main difficulty was to observe all your dynamically-generated UI inputs at once. Turns out it could be done using observe and lapply.
Observing several inputs is problematic because the error Must use single string to index into reactivevalues is returned by trying to index input by a vector or list.
Now, Why this can't be done out-of-the-box is a good question.
I have code to present a table in my R Shiny application. There is a character column where the value within a given cell can be a large number of characters. I use the following code to create the table:
output$data_table <- DT::renderDataTable({
req(data_go_go())
data_go_go()
},rownames = FALSE,filter = "top")
Then display the table with:
DT::dataTableOutput("data_table")
This code results in the following table:
You can see the string in the last column is causing the table to extend very far to the right. Is there a way I can prevent the column from displaying the entire string, and let it display the whole text if you hover over the particular cell?
Here is one option, borrowed heavily from this SO answer written by Stéphane Laurent (R shiny DT hover shows detailed table)
library(shiny)
library(DT)
g = data.frame(
TermID = c("GO:0099536", "GO:0009537", "GO:0007268"),
TermLabel = rep("synaptic signaling",times=3),
Reference= c(907,878,869),
Genes=c(78,74,72),
FoldEnrichment=c(13.69,17.11,14.22),
AdjPValue = c(0,0,0),
`Gene Info` = "Gene Information",
GenesDetail= replicate(paste0(sample(c(" ", letters),100,replace=TRUE), collapse=""),n=3)
)
callback <- c(
"table.on('mouseover', 'td', function(){",
" var index = table.cell(this).index();",
" Shiny.setInputValue('cell', index, {priority: 'event'});",
"});"
)
ui <- fluidPage(DTOutput("geneTable"))
server <- function(input, output, session){
output[["geneTable"]] <- renderDT({
datatable(g[,1:7],callback = JS(callback))
})
filteredData <- eventReactive(input[["cell"]], {
if(input[["cell"]]$column == 7){
return(g[input[["cell"]]$row + 1, "GenesDetail", drop = FALSE])
}
})
output[["tblfiltered"]] <- renderDT({
datatable(filteredData(),fillContainer = TRUE, options=list(dom='t'),rownames = F)
})
observeEvent(filteredData(), {
showModal(modalDialog(
DTOutput("tblfiltered"), size = "l",easyClose = TRUE)
)
})
}
shinyApp(ui, server)
The easiest way is to use the ellipsis plugin:
library(DT)
dat <- data.frame(
A = c("fnufnufroufrcnoonfrncacfnouafc", "fanunfrpn frnpncfrurnucfrnupfenc"),
B = c("DZDOPCDNAL DKODKPODPOKKPODZKPO", "AZERTYUIOPQSDFGHJKLMWXCVBN")
)
datatable(
dat,
plugins = "ellipsis",
options = list(
columnDefs = list(list(
targets = c(1,2),
render = JS("$.fn.dataTable.render.ellipsis( 17, false )")
))
)
)
I'm trying to create a console and enter code to display in the panel.
Based on this solution, I created this code.
But when running, for example, the following lines the output is printed in the console, but not on the Shiny App.
x <- data.frame("SN" = 1:2, "Age" = c(21,15), "Name" = c("John","Dora"))
print(x)
How do I make this output appear on the Shiny app?
Code:
library(shiny)
library(shinyAce)
ui <- fluidPage(
wellPanel(
tagList(wellPanel(uiOutput("plotorprint")))
),
wellPanel(
aceEditor("code", mode = "r", height = "100px",
highlightActiveLine = FALSE,
showLineNumbers = FALSE,
minLines = 2,
maxLines = 30,
fontSize = 16,
autoScrollEditorIntoView = TRUE,
placeholder = "CONSOLE"))
)
server <- function(input, output) {
ace_obj <- reactive({
eval(parse(text=input$code))
})
output$printout <- renderPrint({
ace_obj()
})
output$plotout <- renderPlot({
ace_obj()
})
output$plotorprint <- renderUI({
if (is.data.frame(ace_obj)) { # Check if output of f(x) is data.frame
verbatimTextOutput("printout") # If so, create a print
} else { # If not,
plotOutput("plotout") # create a plot
}
})
}
shinyApp(ui = ui, server = server)
I'm trying to display output in the white space above the console panel.
You could use req() (require) to only evaluate renderPrint and renderPlot if your condition is met (you can add as many conditions as you like for both plot and print in require):
library(shiny)
library(shinyAce)
ui <- fluidPage(
wellPanel(
tagList(wellPanel(
verbatimTextOutput("printout"),
plotOutput("plotout")
))
),
wellPanel(
aceEditor("code", mode = "r", height = "100px",
highlightActiveLine = FALSE,
showLineNumbers = FALSE,
minLines = 2,
maxLines = 30,
fontSize = 16,
autoScrollEditorIntoView = TRUE,
placeholder = "CONSOLE"))
)
server <- function(input, output) {
ace_obj <- reactive({
eval(parse(text=input$code))
})
output$printout <- renderPrint({
req(ace_obj(), is.data.frame(ace_obj()))
ace_obj()
})
output$plotout <- renderPlot({
req(ace_obj())
ace_obj()
})
}
shinyApp(ui = ui, server = server)
A simpler solution including renderUI is fixing the if-condition. ace_obj is a reactive object and is evaluated only with ace_obj():
output$plotorprint <- renderUI({
if (is.data.frame(ace_obj())) { # Check if output of f(x) is data.frame
verbatimTextOutput("printout") # If so, create a print
} else { # If not,
plotOutput("plotout") # create a plot
}
})
Then evaluate in your interactive shiny console without print():
x <- data.frame("SN" = 1:2, "Age" = c(21,15), "Name" = c("John","Dora"))
x
I understand similar questions have been asked and I've tried virtually every solution with no luck.
In my application, I've allowed the user to modify individual cells of a DT::datatable. The source of the datatable is a reactive data frame.
After the user makes changes to the clientside datatable, the datatable source is remains unchanged. This is an issue as later on, when I allow the user to add rows to the data table, the row is added onto the source datatable where the clientside datatable then reflects this change. However, this means that if the user makes a change to a cell in the clientside datatable, when the user adds a row to the same table, the change made by the user will be forgotten as it was never made to the source.
I've tried many ways to update the underlying/serverside datatable with no luck. editData keeps giving me errors/NA. I also have tried indexing the serverside table and placing the changed value inside of it, with no luck. I'll post my code below with some comments for specifics..
library(shiny)
library(DT)
library(data.table)
source('~/camo/camo/R/settings.R')
source('~/camo/camo/etl.R')
# Define UI ----
ui <- fluidPage(
titlePanel("PAlpha"),
mainPanel(
fluidRow(
tabsetPanel(id = 'tpanel',
type = "tabs",
tabPanel("Alpha", plotOutput("plot1")),
tabPanel("Beta", plotOutput("plot2")),
tabPanel("Charlie", plotOutput("plot3")),
tabPanel("Delta", plotOutput("plot4")))
),
fluidRow(
splitLayout(
dateInput("sdate", "Start Date"),
dateInput("edate", "End Date"),
textInput("gmin", "Global Minimum"),
textInput("gmax", "Global Maximum")
)
),
fluidRow(
splitLayout(
textInput("groupInp", NULL, placeholder = "New Group"),
actionButton("addGrpBtn", "Add Group"),
textInput("tickerInp", NULL, placeholder = "New Ticker"),
actionButton("addTickerBtn", "Add Ticker")
)
),
fluidRow(
splitLayout(
DT::dataTableOutput('groupsTable'),
DT::dataTableOutput('groupTickers')
),
verbatimTextOutput("print")
)
)
)
# Define server logic ----
server <- function(input, output) {
port_proxy <- dataTableProxy('groupsTable')
rv <- reactiveValues(
portfolio = data.frame('Group' = c('Portfolio'), 'Minimum Weight' = c(0), 'Maximum Weight' = c(0), 'Type' = c('-')),
groups = list(group1 = data.frame('Group' = c('Ticker'), 'Minimum Weight' = c(0), 'Maximum Weight' = c(0), 'Type' = c('-'))),
deletedRows = NULL,
deletedRowIndices = list()
)
output$groupsTable <- DT::renderDataTable(
# Add the delete button column
deleteButtonColumn(rv$portfolio, 'delete_button')
)
output$print <- renderPrint({
rv$portfolio
})
############## LISTENERS ################
observeEvent(input$deletePressed, {
rowNum <- parseDeleteEvent(input$deletePressed)
dataRow <- rv$portfolio[rowNum,]
# Put the deleted row into a data frame so we can undo
# Last item deleted is in position 1
rv$deletedRows <- rbind(dataRow, rv$deletedRows)
rv$deletedRowIndices <- append(rv$deletedRowIndices, rowNum, after = 0)
# Delete the row from the data frame
rv$portfolio <- rv$portfolio[-rowNum,]
})
observeEvent(input$addGrpBtn, {
row <- data.frame('Group' = c(input$groupInp),
'Minimum Weight' = c(0),
'Maximum Weight' = c(0),
'Type' = c('-'))
rv$portfolio <- addRowAt(rv$portfolio, row, nrow(rv$portfolio))
})
observeEvent(input$groupsTable_cell_edit,{
info <- str(input$groupsTable_cell_edit)
i <- info$row
j <- info$col
v <- info$value
rv$portfolio <- editData(rv$portfolio, input$groupsTable_cell_edit) # doesn't work see below
# Warning in DT::coerceValue(v, data[i, j, drop = TRUE]) :
# New value(s) "test" not in the original factor levels: "Portfolio"; will be coerced to NA.
# rv$portfolio[i,j] <- input$groupsTable_cell_edit$value
# rv$portfolio[i,j] <- v #doesn't work
})
}
addRowAt <- function(df, row, i) {
# Slow but easy to understand
if (i > 1) {
rbind(df[1:(i - 1), ], row, df[-(1:(i - 1)), ])
} else {
rbind(row, df)
}
}
deleteButtonColumn <- function(df, id, ...) {
# function to create one action button as string
f <- function(i) {
# https://shiny.rstudio.com/articles/communicating-with-js.html
as.character(actionLink(paste(id, i, sep="_"), label = 'Delete', icon = icon('trash'),
onclick = 'Shiny.setInputValue(\"deletePressed\", this.id, {priority: "event"})'))
}
deleteCol <- unlist(lapply(seq_len(nrow(df)), f))
# Return a data table
DT::datatable(cbind(' ' = deleteCol, df),
# Need to disable escaping for html as string to work
escape = FALSE,
editable = 'cell',
selection = 'single',
rownames = FALSE,
class = 'compact',
options = list(
# Disable sorting for the delete column
dom = 't',
columnDefs = list(list(targets = 1, sortable = FALSE))
))
}
parseDeleteEvent <- function(idstr) {
res <- as.integer(sub(".*_([0-9]+)", "\\1", idstr))
if (! is.na(res)) res
}
# Run the app ----
shinyApp(ui = ui, server = server)
As far as I have looked, there is no ready-to-go solution available. You could try to use rhandsontable. It does not provide all the functionality of the DT table, however it allows for the editing. Last time I tried using it there were some minor issues in some edge cases. (Trying to save different data type or something similar.)
Alternatively you can do the stuff manually, along these lines. This is the minimal working example of editing the underlying data frame. Currently I overwrite it every time the user clicks on the table, you would need to change that to handle normal user behavior. It is meant merely as a proof of concept.
library(DT)
library(shiny)
ui <- fluidPage(
DT::dataTableOutput("test")
)
myDF <- iris[1:10,]
js <- c("table.on('click.dt','tr', function() {",
" var a = table.data();",
" var data = []",
" for (i=0; i!=a.length; i++) {",
" data = data.concat(a[i]) ",
" };",
"Shiny.setInputValue('dataChange', data)",
"})")
server <- function(input, output) {
output$test <- DT::renderDataTable(
myDF,
editable='cell',
callback=JS(js)
)
observeEvent(input$dataChange, {
res <- cbind.data.frame(split(input$dataChange, rep(1:6, times=length(input$dataChange)/6)),
stringsAsFactors=F)
colNumbers <- res[,1]
res <- res[,2:ncol(res)]
colnames(res) <- colnames(myDF)
myDF <<- res
print(myDF)
})
}
shinyApp(ui = ui, server = server)
I am trying to build an app that displays a .csv file in table format. The user can choose with radio buttons one of two ways to display the table. I have defined those two ways with the filedata() and data_ranked_words() reactives.
To reproduce this error, please first run this code chunk to get a small subset of my data:
test = rbind(
c(0.00000009, 0.00000009, 0.00046605, 0.00015541, 0.00215630),
c(0.00000016, 0.00137076, 0.00000016, 0.00000016, 0.00000016),
c(0.00012633, 0.00000014, 0.00000014, 0.00000014, 0.00075729),
c(0.00000013, 0.00000013, 0.00000013, 0.00000013, 0.00062728)
)
colnames(test) = c('church', 'appearance', 'restrain', 'parity', 'favor')
rownames(test) = NULL
test = as.data.frame(test)
write.csv(test, 'test.csv', row.names = FALSE)
You will see that you get an Error invalid argument to binary operator as soon as the program launches. Then choose test.csv off your filesystem in your working directory and you will see that the error persists while 'Word View' is selected, but the table correctly displays while 'Probability View' is selected.
This app is very simple. The problem occurs in line 66 temp = matrix(row.names(data)[apply(-data, 2, order)], nrow(data)). It doesn't like the -data within the apply. However, try as I might, I have not been able to reproduce this error just working in the R console, outside of shiny. In regular R, this line runs just fine.
What I am trying to do is display two different tables when the user selects the radio buttons. 'Probability View' is the raw table as is, and 'Word View' is the table with some operations on it (lines 61-71). I can't figure this one out!
Here is my app:
library(shiny)
library(markdown)
library(DT)
library(D3TableFilter)
options(shiny.maxRequestSize=50*1024^2)
# ui.R
#-------------------------------------------------------------------------------------
ui <- shinyUI(
navbarPage("Topic Model App v1.0",
tabPanel("From CSV",
sidebarLayout(
sidebarPanel(
# Define what's in the sidebar
fileInput("file",
"Choose CSV files from directory",
multiple = TRUE,
accept=c('text/csv',
'text/comma-separated-values,text/plain',
'.csv')),
radioButtons('toggle', 'Choose one:',
list('Word View', 'Probability View'))
),
# Define what's in the main panel
mainPanel(
title = 'Topic Model Viewer',
# How wide the main table will be
fluidRow(
column(width = 12, d3tfOutput('data'))
)
)
)
)
)
)
# server.R
#-------------------------------------------------------------------------------------
server <- shinyServer(function(input, output, session) {
# Set up the dataframe for display in the table
# Define 'filedata()' as the .csv file that is uploaded
filedata <- reactive({
infile <- input$file
if (is.null(infile)) {
# User has not uploaded a file yet
return(NULL)
}
# Read in .csv file and clean up
data = read.csv(infile$datapath)
data = t(data)
data = as.data.frame(data)
colnames(data) = paste0(rep('topic', ncol(data)), 1:ncol(data))
data = format(data, scientific = FALSE)
data
})
#PROBLEM
# The ranked and ordered csv file
data_ranked_words <- reactive({
# Sort each column by probability, and substitute the correct word into that column
# This will essentially rank each word for each topic
# This is done by indexing the row names by the order of each column
data = filedata()
temp = matrix(row.names(data)[apply(-data, 2, order)], nrow(data))
temp = as.data.frame(temp)
colnames(temp) = paste0(rep('topic', ncol(data)), 1:ncol(data))
temp
})
# Create table
output$data <- renderD3tf({
tableProps <- list(
rows_counter = TRUE,
rows_counter_text = "Rows: ",
alternate_rows = TRUE
);
# Radio buttons
# The reason why the extensions are in this if() is so that sorting can be
# activated on Probability View, but not Word View
if(input$toggle=='Word View'){
df = data_ranked_words()
extensions <- list(
list( name = "colsVisibility",
text = 'Hide columns: ',
enable_tick_all = TRUE
),
list( name = "filtersVisibility",
visible_at_start = FALSE)
)
} else if(input$toggle=='Probability View'){
df = filedata()
extensions <- list(
list(name = "sort"), #this enables/disables sorting
list( name = "colsVisibility",
text = 'Hide columns: ',
enable_tick_all = TRUE
),
list( name = "filtersVisibility",
visible_at_start = FALSE)
)
}
if(is.null(filedata())){
} else{
d3tf(df,
tableProps = tableProps,
extensions = extensions,
showRowNames = TRUE,
tableStyle = "table table-bordered")
}
})
# This line will end the R session when the Shiny app is closed
session$onSessionEnded(stopApp)
})
# Run app in browser
runApp(list(ui=ui,server=server), launch.browser = TRUE)
So a couple of problems are interacting here to make things difficult to diagnose:
It is running through and trying to execute before the data is defined. The "modern" way to avoid that is to use a req(input$file) - which is now inserted in the filedata reactive. Note that will break the entire chain from executing until input$file is defined in the shiny ui.
The data = format(data, scientific = FALSE) is converting your columns to vectors of type "AsIs", which the unitary minus command does not know how to operate on. It is commented out of filedata() now.
To get that functionality of suppressing the scientific notation back, the was moved to right after where df is created by filedata() before it is displayed in d3tf.
Note: I found it interesting that options with scipen did not work here. Not sure why that is the case, but this AsIs class does the trick.
Here is the adjusted code:
library(shiny)
library(markdown)
library(DT)
library(D3TableFilter)
options(shiny.maxRequestSize=50*1024^2)
# ui.R
#-------------------------------------------------------------------------------------
ui <- shinyUI(
navbarPage("Topic Model App v1.0",
tabPanel("From CSV",
sidebarLayout(
sidebarPanel(
# Define what's in the sidebar
fileInput("file",
"Choose CSV files from directory",
multiple = TRUE,
accept=c('text/csv',
'text/comma-separated-values,text/plain',
'.csv')),
radioButtons('toggle', 'Choose one:',
list('Word View', 'Probability View'))
),
# Define what's in the main panel
mainPanel(
title = 'Topic Model Viewer',
# How wide the main table will be
fluidRow(
column(width = 12, d3tfOutput('data'))
)
)
)
)
)
)
# server.R
#-------------------------------------------------------------------------------------
server <- shinyServer(function(input, output, session) {
# Set up the dataframe for display in the table
# Define 'filedata()' as the .csv file that is uploaded
filedata <- reactive({
req(input$file)
infile <- input$file
if (is.null(infile)) {
# User has not uploaded a file yet
return(NULL)
}
# Read in .csv file and clean up
data = read.csv(infile$datapath)
data = t(data)
data = as.data.frame(data)
colnames(data) = paste0(rep('topic', ncol(data)), 1:ncol(data))
# data = format(data, scientific = FALSE)
data
})
#PROBLEM
# The ranked and ordered csv file
data_ranked_words <- reactive({
# Sort each column by probability, and substitute the correct word into that column
# This will essentially rank each word for each topic
# This is done by indexing the row names by the order of each column
data = filedata()
temp = matrix(row.names(data)[apply(-data, 2, order)], nrow(data))
temp = as.data.frame(temp)
colnames(temp) = paste0(rep('topic', ncol(data)), 1:ncol(data))
temp
})
# Create table
output$data <- renderD3tf({
tableProps <- list(
rows_counter = TRUE,
rows_counter_text = "Rows: ",
alternate_rows = TRUE
);
# Radio buttons
# The reason why the extensions are in this if() is so that sorting can be
# activated on Probability View, but not Word View
if(input$toggle=='Word View'){
df = data_ranked_words()
extensions <- list(
list( name = "colsVisibility",
text = 'Hide columns: ',
enable_tick_all = TRUE
),
list( name = "filtersVisibility",
visible_at_start = FALSE)
)
} else if(input$toggle=='Probability View'){
df = filedata()
df = format(df, scientific = FALSE)
extensions <- list(
list(name = "sort"), #this enables/disables sorting
list( name = "colsVisibility",
text = 'Hide columns: ',
enable_tick_all = TRUE
),
list( name = "filtersVisibility",
visible_at_start = FALSE)
)
}
if(is.null(filedata())){
} else{
d3tf(df,
tableProps = tableProps,
extensions = extensions,
showRowNames = TRUE,
tableStyle = "table table-bordered")
}
})
# This line will end the R session when the Shiny app is closed
session$onSessionEnded(stopApp)
})
# Run app in browser
runApp(list(ui=ui,server=server), launch.browser = TRUE)
And here is a screen shot of it running: