Two Reactives R Shiny - r

I need to render a table based on user input which will be one of two possible tables. I have defined the first table filedata by the user selecting a .csv file to upload. The second table, data_ranked_words, has the same dimensions.
What I want is for the output to switch between the two tables. I defined each table in a reactive(). However, I know that the data_ranked_words reactive is never being triggered. How do I trigger both of these reactives when the user uploads a file? In my code the issue is with the two reactive() statements at the beginning of server.R.
library(shiny)
library(markdown)
library(DT)
library(D3TableFilter)
options(shiny.maxRequestSize=50*1024^2)
setwd('~/Desktop/DSI/Topic Model App Interface')
# ui.R
#-------------------------------------------------------------------------------------
ui <- shinyUI(
navbarPage("Start",
tabPanel("From Data",
sidebarLayout(
sidebarPanel(
radioButtons("plotType", "Plot type",
c("Scatter"="p", "Line"="l")
)
),
mainPanel(
plotOutput("plot")
)
)
),
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')),
h5(div(HTML('Use the radio butons to toggle between the <em>Word View</em> and
<em>Probability View</em>.'))),
radioButtons('toggle', 'Choose one:', list('Word View', 'Probability View')),
p(div(HTML('<strong>Note:</strong> The <em>Probability View</em> will
<u>not</u> yield the top X number of words. It will instead
return the first X columns. You can then sort each column in
ascending or descending order. Keep in mind that it will only
sort from the rows that are displayed, <u>not</u> all rows.'))),
br(),
sliderInput('slider', div(HTML('How many rows to display?')), 1, 100, 20),
br(),
h5('Use the buttons below to quickly show large numbers of rows.'),
radioButtons('rowIdentifier', 'Show more rows:',
list('[ Clear ]', '200', '500', '1000', '5000', '10000', 'All Rows')),
p(div(HTML('<strong>Warning:</strong> Printing all rows to the screen may
take a while.'))),
h3('Tips:'),
p("You can copy and paste the table into Excel. If you only want to
copy one column, use the 'Show/Hide' function at the top-right of the table
to hide all the undesired columns."),
p(div(HTML('Sorting by column is available in <em>Probability View</em> but
not <em>Word View</em>.')))
),
# 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'))
)
)
)
),
navbarMenu("More",
tabPanel("temp"
),
tabPanel("About",
fluidRow(
column(6
),
column(3
)
)
)
)
)
)
# 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)
}
temp = read.csv(infile$datapath)
# Save data as RDS file, which is much faster than csv
saveRDS(temp, file = 'data.rds')
# Read in data file
data = readRDS('data.rds')
# Transpose data for more intuitive viewing. Words as rows, topics as cols
data = t(data)
# Convert to data frame
data = as.data.frame(data)
# Return this
data
})
# The ranked and ordered csv file
data_ranked_words <- reactive({
data = filedata()
# 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
temp = matrix(row.names(data)[apply(-data, 2, order)], nrow(data))
temp = as.data.frame(temp)
# Define column names (same as before) for the new data frame
colnames(temp) = paste0(rep('topic', ncol(data)), 1:ncol(data))
# Return this
temp
print('Success')
})
output$data <- renderD3tf({
# Define table properties. See http://tablefilter.free.fr/doc.php
# for a complete reference
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)
)
}
# Radio button options for more row viewing options
if(input$rowIdentifier=='Clear'){
num_rows = input$slider
} else if(input$rowIdentifier==200){
num_rows = 200
} else if(input$rowIdentifier==500){
num_rows = 500
} else if(input$rowIdentifier==1000){
num_rows = 1000
} else if(input$rowIdentifier==5000){
num_rows = 5000
} else if(input$rowIdentifier==10000){
num_rows = 10000
} else if(input$rowIdentifier=='All Rows'){
num_rows = nrow(df)
} else{
num_rows = input$slider
}
# Create table
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)

Related

R shiny sortable clone element in rank list not working

I have a shiny app where the user uploads a csv file. Then, using the column names from the csv file, I create sortable bucket list. I would like drag the column name from the first rank list and have it cloned (i.e. not depleted). I tried to use the options parameter in add_rank_list() setting pull='clone', but that did not work. Any idea on how to do this? Below is my code, and some fake data can be accessed here.
library(shiny)
library(shinyjs)
library(sortable)
ui <- fluidPage(
titlePanel("App"),
sidebarLayout(
sidebarPanel(
useShinyjs(),
fileInput(inputId = "file1", label = "Select a .csv file",
accept = c("text/csv", "text/comma-separated-values,text/plain",".csv")
),
uiOutput("show_button")
),
mainPanel(
DT::dataTableOutput("table")
)
),
fluidRow(uiOutput("buckets"))
)
server <- function(input, output) {
# input csv file
input_file <- reactive({
if (is.null(input$file1)) {
return("")
}
# actually read the file
read.csv(file = input$file1$datapath)
})
# button to hide/show table
## only show when table is loaded
output$show_button = renderUI({
req(input$file1)
actionButton(inputId = "button", label = "show / hide table")
})
## observe the button being pressed
observeEvent(input$button, {
shinyjs::toggle("table")
})
# output table
output$table <- DT::renderDataTable({
# render only if there is data available
req(input_file())
# reactives are only callable inside an reactive context like render
data <- input_file()
data
})
# Drag and Drop Col names
output$buckets = renderUI(
{
# create list of colnames
req(input$file1)
data = input_file()
cols = colnames(data)
# create bucket list
bucket_list(
header = "Drag the items in any desired bucket",
group_name = "bucket_list_group",
orientation = "horizontal",
add_rank_list(
text = "Drag from here",
labels = as.list(cols),
input_id = "rank_list_1",
css_id = "list1",
options = sortable_options(
group = list(
pull = "clone",
name = "list_group1",
put = FALSE))
),
add_rank_list(
text = "to here",
labels = NULL,
input_id = "rank_list_2",
css_id = "list2",
options = sortable_options(group = list(name = "list_group1")))
)
})
}
# Run the application
shinyApp(ui = ui, server = server)

download the modified table in shiny

I would like to download the modified version of the table when I use the filter option in the table. Since the table is reactive based on the columns, only the chosen columns will be included in the downloaded dataset, however, every row is also included.
So for example, I choose 4 different columns and filter the dataset based on the columns and get only 2 rows. Is there a way to download this specific version of the table after the filter, instead of downloading the whole dataset?
library(shiny)
library(DT)
ui <- fluidPage(
title = "DataTables",
sidebarLayout(
sidebarPanel(
conditionalPanel(
'input.dataset == "cars"',
selectInput('col', ' ',choices = names(cars),multiple = TRUE,selected = c("price", "Mileage", "Cylinder")),
downloadButton("download_cars", "Download data")
)
),
mainPanel(
tabsetPanel(
id = 'dataset',
tabPanel("cars",
DT::dataTableOutput("mytable1"),
)
)
)
))
server <- function(input, output) {
car_data <- eventReactive(input$col, {
df <- cars[, input$col, drop = FALSE]
df
})
output$mytable1 <- DT::renderDataTable({
DT::datatable(car_data(), filter = "top", options = list(
orderClasses = TRUE
)
)
})
output$download_car <- downloadHandler(
filename = function() {paste("All_cars.csv", Sys.Date(), ".csv", sep = "")},
content = function(file){
write.csv(car_data(), file, row.names = FALSE)
}
)
}
shinyApp(ui, server)

updatePickerInput instantly refreshing update

I have almosat completed a very basic web app in shiny.
I have it functioning as intended, however I believe I have incorrectly used "updatePickerInput" as the table is rendered as expected, however I am not able to select any options in my two pickers as it seems to continue to instantly refresh. I assume this is because the session is looking for input and then regenerating the output, which includes my picker refresh (so I have causes a cyclical refresh). I may be wrong though.
I have looked up the literature but I am unsure exactly what i have done wrong and what the syntax should be to prevent this from occuring.
Typical input is a .csv matrix with different animals on X-axis row 1 (column names) and Y-axis column 1 (row names) with values between any two animals.
library(shiny)
library(ggplot2)
library(shinyWidgets)
library(DT)
options(shiny.maxRequestSize = 50*1024^2)
# Define UI
ui <- fluidPage(
# Application title
titlePanel("Interactive Relatedness Comparison"),
# Sidebar inputs
sidebarLayout(
mainPanel(dataTableOutput("contents")),
sidebarPanel(
#Upload GRM file
fileInput("file1", "Choose GRM File", accept= c(
"text/csv",
"text/comma-separated-values,text/plain",
".csv")),
#Client can choose sires along x-axis
pickerInput(
inputId = "sireselect",
label = "Select Sires",
choices = "Please Upload GRM",
multiple = TRUE,
options = pickerOptions(actionsBox = TRUE, liveSearch = TRUE),
),
#Client can choose dams along y-axis
pickerInput(
inputId = "damselect",
label = "Select Dams",
choices = "Please Upload GRM",
multiple = TRUE,
options = pickerOptions(actionsBox = TRUE, liveSearch = TRUE),
),
#Show raw values
checkboxInput("relatedness", "Show Values (will reset sorting)", value = FALSE),
)
),
)
server <- function(input, output, session) {
#Output uploaded table as data table
output$contents <- DT::renderDataTable({
rownames = TRUE
inFile <- input$file1
if (is.null(inFile))
return(NULL)
file2 <- read.csv(inFile$datapath)
#shiney data table render was not showing row names correctly, changed to DT
rownames(file2) <- file2[,1]
#Remove first column which is now the rownames
file2 <- file2[-c(1)]
#Update pickers for the row/column names
updatePickerInput(session, inputId = "damselect", choices = rownames(file2), selected = rownames(file2))
updatePickerInput(session, inputId = "sireselect", choices = colnames(file2), selected = colnames(file2))
#Create summarized data table (to be primary view unless raw values selected)
newgrid <- as.data.frame(file2)
#Generate summarised data table
for (irow in 1:nrow(file2)){
for (icol in 1:ncol(file2)){
dig <- file2[irow,icol]
if (dig >= 0.8) {
newgrid[irow,icol] <- "SAME"
} else if (dig >= 0.3) {
newgrid[irow,icol] <- "HIGH"
} else if (dig >= 0.1) {
newgrid[irow,icol] <- "MED"
} else {
newgrid[irow,icol] <- "NOT"
}
}
}
#Check box for raw values or not
if (input$relatedness == TRUE){
return(file2[input$damselect,input$sireselect])
} else {
return(newgrid[input$damselect,input$sireselect])
}
})
}
# Run the application
shinyApp(ui, server)
Any help would ne much appreciated
Read in data and updatePickerInput outside of output$contents might help. Try this
library(shiny)
library(ggplot2)
library(shinyWidgets)
library(DT)
options(shiny.maxRequestSize = 50*1024^2)
# Define UI
ui <- fluidPage(
# Application title
titlePanel("Interactive Relatedness Comparison"),
# Sidebar inputs
sidebarLayout(
mainPanel(DTOutput("contents")),
sidebarPanel(
#Upload GRM file
fileInput("file1", "Choose GRM File", accept= c(
"text/csv",
"text/comma-separated-values,text/plain",
".csv")),
#Client can choose sires along x-axis
pickerInput(
inputId = "sireselect",
label = "Select Sires",
choices = "Please Upload GRM",
multiple = TRUE,
options = pickerOptions(actionsBox = TRUE, liveSearch = TRUE),
),
#Client can choose dams along y-axis
pickerInput(
inputId = "damselect",
label = "Select Dams",
choices = "Please Upload GRM",
multiple = TRUE,
options = pickerOptions(actionsBox = TRUE, liveSearch = TRUE),
),
#Show raw values
checkboxInput("relatedness", "Show Values (will reset sorting)", value = FALSE),
)
)
)
server <- function(input, output, session) {
file3 <- reactive({
rownames = TRUE
inFile <- input$file1
if (is.null(inFile))
return(NULL)
file2 <- read.csv(inFile$datapath)
#shiney data table render was not showing row names correctly, changed to DT
rownames(file2) <- file2[,1]
#Remove first column which is now the rownames
file2 <- file2[-c(1)]
file2
})
observe({
req(file3())
updatePickerInput(session, inputId = "damselect", choices = rownames(file3()), selected = rownames(file3()))
updatePickerInput(session, inputId = "sireselect", choices = colnames(file3()), selected = colnames(file3()))
})
#Output uploaded table as data table
output$contents <- renderDT({
req(file3())
#Create summarized data table (to be primary view unless raw values selected)
newgrid <- as.data.frame(file3())
#Generate summarised data table
for (irow in 1:nrow(file3())){
for (icol in 1:ncol(file3())){
dig <- file3()[irow,icol]
if (dig >= 0.8) {
newgrid[irow,icol] <- "SAME"
} else if (dig >= 0.3) {
newgrid[irow,icol] <- "HIGH"
} else if (dig >= 0.1) {
newgrid[irow,icol] <- "MED"
} else {
newgrid[irow,icol] <- "NOT"
}
}
}
#Check box for raw values or not
if (input$relatedness == TRUE){
return(file3()[input$damselect,input$sireselect])
}else {
return(newgrid[input$damselect,input$sireselect])
}
})
}
# Run the application
shinyApp(ui, server)

How to replace columns with first rows RSHINY

Here is my shiny app. Now I cant be able o share data for running it but basically this app has multiple csvs saved in ./data folder. What I am trying to do is compare each csv in two pairs of each. Now when I select CSV files from the dropdown menu and compare I have some result table with column names messed up and that means I am supposed to delete the column names and replace them with the first row of the data, Then I still have other results that I get after comparing other files and I get right column names that I don't have to replace.
library("shiny")
library(daff)
library(dplyr)
library(shinythemes)
library("DT")
library(readr)
library(stringr)
library(tidyr)
library(purrr)
library(janitor)
library(data.table)
library(magrittr)
library(plyr)
setwd("path")
ui = fluidPage(
titlePanel("Automated Data Dictionary Comparison"),
sidebarLayout(
sidebarPanel(
selectInput(inputId = 'Dic1',
label = 'Choose First Data Dictionary:',
choices = list.files(path = "./data",
full.names = FALSE,
recursive = FALSE)),
selectInput(inputId = 'Dic2',
label = 'Choose Second Data Dictionary:',
choices = list.files(path = "./data",
full.names = FALSE,
recursive = FALSE)),
actionButton("do", "Replace columns"),
tags$hr(),
# This one is linked by the id 'download'
downloadButton('download',"Download the data")
),
mainPanel (
tabsetPanel(
tabPanel('Html Table',
HTML("<div style ='overflow:auto; height:500px; width:800px ' >"),
uiOutput('contents'),
HTML("</div>")
),
tabPanel('Diff Table',
fluidRow(
column(div(DT::dataTableOutput("mytable"), style = "font-size: 75%; width: 75%"),width = 12)
)
),
tabPanel("Modified table",
fluidRow(
column(div(DT::dataTableOutput("modified"), style = "font-size: 75%; width: 75%"),width = 12)
)
),
tabPanel("Added table",
fluidRow(
column(div(DT::dataTableOutput("added"), style = "font-size: 75%; width: 75%"),width = 12)
)
)
)
)
)
)
server = function(input, output){
# Parse first file
dataset1 <- reactive({
infile <- input$Dic1
if (is.null(infile)){
return(NULL)
}
x <- read.csv(paste0("./data/", infile[[1]]))
x
})
# Parse second file
dataset2 <- reactive({
infile <- input$Dic2
if (is.null(infile)){
return(NULL)
}
x <- read.csv(paste0("./data/", infile[[1]]))
x
})
# Create difference table then save
diff1 <- reactive( {
dd <- diff_data(data_ref=dataset1(), data=dataset2())
write_diff(dd, "./data/diffrev.csv")
diff_df <- readr::read_csv("./data/diffrev.csv")
ft <-as.data.frame(lapply(diff_df, iconv, from = 'UTF-8', to = 'UTF-8'), stringsAsFactors = FALSE)
ft
})
output$mytable <- renderDataTable({
diff1()
},options = list(scrollX = TRUE))
output$download <- downloadHandler(
filename = function(){"thename.csv"},
content = function(fname){
write.csv(thedata(), fname)})
}
shinyApp(ui = ui, server = server)
My first question is how can I smartly delete and replace column names with the first row once I display the diff1 table output? I am thinking of using an action button which I can be able to delete those tables with unwanted columns but it will still delete wanted columns from the output.
What I expect is once I see unwanted columns in the output , I can replace them but once I see wanted columns in the output, I should choose to keep them

Two Reactives Error Invalid Argument to Unary Operator

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:

Resources