Reactive Function - r

Prior to start creating my app with Shiny I've created a function (NextWordPrediction) that updates my dataframe based on an user's input as follows:
If input exists in df increase its Frequency by 1
If input does't exist in df add it
Function code:
NextWordPrediction <- function(input) {
dat <- dat %>%
filter(., N_gram == str_count(input, "\\S+") + 1) %>%
filter(grepl(paste("^", tolower(str_squish(input)), sep = ""), Word)) %>%
arrange(., desc(Prop))
if (nrow(dat) != 0) {
assign("dat",
dat %>%
mutate(Frequency = ifelse(Word == input &
N_gram == str_count(input, "\\S+"),
Frequency + 1,
Frequency)) %>%
group_by(., N_gram) %>%
mutate(., Prop = Frequency/ sum(Frequency)) %>%
data.frame(.),
envir = .GlobalEnv)
val <- dat$Word_to_Predict[1]
ans <- paste(str_squish(input), val)
return(list(ans, head(dat,5)))
} else if (nrow(dat) == 0 & word(input, 1) != "NA") {
assign("dat",
dat %>%
add_row(., Word = tolower(input), Frequency = + 1, N_gram = str_count(input, "\\S+"),
Word_to_Predict = word(input, -1)) %>%
group_by(., N_gram) %>%
mutate(., Prop = Frequency/ sum(Frequency)) %>%
data.frame(.),
envir = .GlobalEnv)
input_1 <- Reduce(paste, word(input, 2:str_count(input,"\\S+")))
return(NextWordPrediction(input_1))
} else if (word(input, 1) == "NA") {
ans <- paste("Word not in dictionary. We added this to our database!")
return(ans)
}
}
As a next step I want to extend this functionality to a Shiny app and I've tried the following without success. The function usability is functional but after an input my df is not updated accordingly.
server.R
library(shiny)
dat <- read.csv("dat_all.csv")
shinyServer(function(input, output) {
NextWordPrediction <- function(input) {
dat <- dat %>%
filter(., N_gram == str_count(input, "\\S+") + 1) %>%
filter(grepl(paste("^", tolower(str_squish(input)), sep = ""), Word)) %>%
arrange(., desc(Prop))
if (nrow(dat) != 0) {
assign("dat",
dat %>%
mutate(Frequency = ifelse(Word == input &
N_gram == str_count(input, "\\S+"),
Frequency + 1,
Frequency)) %>%
group_by(., N_gram) %>%
mutate(., Prop = Frequency/ sum(Frequency)) %>%
data.frame(.),
envir = .GlobalEnv)
val <- dat$Word_to_Predict[1]
ans <- paste(str_squish(input), val)
return(list(ans, head(dat,5)))
} else if (nrow(dat) == 0 & word(input, 1) != "NA") {
assign("dat",
dat %>%
add_row(., Word = tolower(input), Frequency = + 1, N_gram = str_count(input, "\\S+"),
Word_to_Predict = word(input, -1)) %>%
group_by(., N_gram) %>%
mutate(., Prop = Frequency/ sum(Frequency)) %>%
data.frame(.),
envir = .GlobalEnv)
input_1 <- Reduce(paste, word(input, 2:str_count(input,"\\S+")))
return(NextWordPrediction(input_1))
} else if (word(input, 1) == "NA") {
ans <- paste("Word not in dictionary. We added this to our database!")
return(ans)
}
}
output$predictiontext = reactive({
NextWordPrediction(input$text)[1]
})
output$predictiontable = renderTable({
NextWordPrediction(input$text)[2]
})
})
ui.R
library(shiny)
# Define UI for application that draws a histogram
shinyUI(fluidPage(
# Application title
titlePanel("NextWordPrediction"),
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
textInput("text",
"Type something...",
"")
),
# Show a plot of the generated distribution
mainPanel(
wellPanel(
# Link to report
helpText(a('More information on the app',
href=link,
target = '_blank')
),
# Link to repo
helpText(a('Code repository',
href=link,
target = '_blank')
),
textOutput("predictiontext"),
tableOutput('predictiontable')
)
)
))
)
Update 1: Data
df<- data.frame(Word = c("hello", "she was great", "this is", "long time ago in"), Frequency = c(4, 3, 10, 1),
N_gram = c(1, 3, 2, 4), Prop = c(4/18, 3/18, 10/18, 1/18), Word_to_Predict = c(NA, "great", "is", "in"))
NextWordPrediction("she was") ## returns "she was" & "great"
NextWordPrediction("hours ago") ## returns "hours ago" & "in"
NextWordPrediction("words not in data") ## returns "Word not in dictionary. We added this to our database!" after trying "not in data", "in data" and adds "words not in data" to dataset

Related

How to make selectInput behave dynamically with on user input?

I am trying to create an app that creates word frequency plot from text. The data I used is here: https://www.kaggle.com/datasets/bharadwaj6/kindle-reviews#:~:text=Never-,kindle_reviews,-.csv(701.88
Following is my shiny code:
library(shiny)
library(tidyverse)
library(tidytext)
# Source functions
source("wrd_freq_df.R")
source("bigrm_df.R")
# UI design ----
ui <- fluidPage(fluidRow(
column(
4,
fileInput("upload", NULL, accept = c(".csv", ".tsv")),
actionButton(
inputId = "submit",
label = "RUN",
class = "btn-primary"
),fluidRow(
column(4, numericInput(
"n",
"Top n words",
value = 5,
min = 1,
step = 1
)),
column(4, selectInput(
"myselect",
label = "Choose Words"
, choices = NULL
, multiple = TRUE
# , options = list(create = TRUE)
, selected = NULL
))),
plotOutput("wrd_frq_plot"),
tableOutput("head")
)
))
# SERVER ----
options(shiny.maxRequestSize = 60 * 1024 ^ 2)
server <- function(input, output, session) {
#upload csv data
data <- reactive({
req(input$upload)
ext <- tools::file_ext(input$upload$name)
switch(
ext,
csv = vroom::vroom(input$upload$datapath, delim = ","),
tsv = vroom::vroom(input$upload$datapath, delim = "\t"),
validate("Invalid file; Please upload a .csv or .tsv file")
)
})
#create different data subset to be used for plotting word_freq and bigrams
rv <- reactiveValues()
#run analysis on pressing run button
observeEvent(input$submit, {
rv$data_head <- data() %>%
mutate(ID = as.character(round(ID))) %>%
mutate(group = if_else(rating >= 4, "High", if_else(rating > 2, "Avg", "Low"))) %>%
select(ID, group, reviewText)
#get base analysis dataset
rv$word_freq <- wrd_freq_df(rv$data_head)
rv$bigrm_freq <- bigrm_freq_df(rv$data_head)
rv$bigrm_tf_idf <- bigrm_freq_tf_idf(rv$bigrm_freq)
#get all unique words from the document
rv$choices <- rv$word_freq %>%
select(word) %>%
unique() %>% unlist()
output$wrd_frq_plot <- renderPlot({
#ensure that if selectinput has no value then all words are used for analysis
if (is.null(input$myselect)) {
selected_choices = rv$choices
}
else{
selected_choices = input$myselect
}
updateSelectInput(session, "myselect", selected = selected_choices)
#get relevant document ID which contains chosen word for analysis
word <- input$myselect
word_df_chose <- data.frame(word)
relvant_ID <- word_df_chose %>%
#THIS IS PROBABLY WHERE THINGS FAILS
inner_join(rv$word_freq) %>%
select(ID) %>%
unique() %>% unlist()
rv$word_freq %>%
filter(ID %in% relevant_ID) %>%
left_join(rv$data_head %>%
select(ID, group) %>%
unique()) %>%
#remove low tf_IDF words
filter(tf_idf > quantile(tf_idf, 0.25)) %>%
group_by(group, word) %>%
summarise(n_tot = sum(n)) %>% ungroup() %>%
group_by(group) %>%
slice_max(n_tot, n = input$n) %>%
ungroup() %>%
mutate(group = as.factor(group),
word = reorder_within(word, n_tot, group)) %>%
ggplot(aes(x = word, y = n_tot, fill = group)) + geom_col() + facet_wrap(group ~
., scales = "free") +
coord_flip() + scale_x_reordered()
})
})
}
#executes app
shinyApp(ui, server)
The functions sourced are as follows:
wrd_freq_df <- function(df){
df %>%
# mutate(ID = as.character(round(ID))) %>%
# mutate(group = if_else(rating >= 4, "High", if_else(rating > 2, "Avg", "Low"))) %>%
# select(ID, group, reviewText) %>%
#get word freq
unnest_tokens(output = word, input = reviewText) %>% ungroup() %>%
anti_join(stop_words) %>%
count(ID, word) %>% ungroup() %>%
group_by(ID) %>%
mutate(total = sum(n)) %>% ungroup() %>%
bind_tf_idf(word, ID, n) }
bigrm_freq_df <- function(df) {
df %>%
# mutate(ID = as.character(round(ID))) %>%
# mutate(group = if_else(rating >= 4, "High", if_else(rating > 2, "Avg", "Low"))) %>%
# select(ID, group, reviewText) %>%
unnest_tokens(bigram, reviewText, token = "ngrams", n = 2) %>%
separate(bigram,
c("word1", "word2"),
sep = " ",
remove = FALSE) %>%
filter(!word1 %in% stop_words$word) %>%
filter(!word2 %in% stop_words$word)
}
bigrm_freq_tf_idf <- function(df) {
df %>%
select(ID, bigram) %>%
#get tf_idf
count(ID, bigram) %>%
bind_tf_idf(bigram, ID, n) %>%
arrange(desc(tf_idf))
}
i get following error message:
Joining, by = "word"
Warning: Error in inner_join: by must be supplied when x and y have no common variables.
ℹ use by = character()` to perform a cross-join.
181:
Input to asJSON(keep_vec_names=TRUE) is a named vector. In a future version of jsonlite, this option will not be supported, and named vectors will be translated into arrays instead of objects. If you want JSON object output, please use a named list instead. See ?toJSON.
I assume that the error must be arising when

How to make a plot axis label reactive?

In the below reproducible example Code 1, the user stratifies data and selects which variable to stratify the data by, Value_1 or Value_2; and also selects to view the stratification as a table or as a plot. Code 1 works as intended, and the stratification range label is a static "Range" (as shown in the table left-most column header and in the plot x-axis label, and as shown in the images at the bottom).
I am making the range label dynamic (reactive), because in the fuller App this example derives from the user has many variables to choose from for stratification.
In Code 2 below showing an amplified custom function stratData(), I have succeeded in making the table left-most column header for stratification ranges reactive, but I haven't yet figured out how to make the plot x-axis label for stratification ranges similarly reactive. Just replace the stratData() in Code 1 with the stratData() in Code 2 (and comment-out the plot code under renderPlot() to avoid seeing the error) to see how this is working (or not).
How could the plot x-axis label reflect the same reactivity as the table left-most column header?
Code 1:
library(ggplot2)
library(shiny)
library(tidyverse)
library(shinyWidgets)
ui <-
fluidPage(
uiOutput("strat_values"),
radioButtons(
inputId = 'stratsView',
label = NULL,
choices = list("Table view" = 1,"Plot view" = 2),
selected = 1,
inline = TRUE
),
conditionalPanel(condition = "input.stratsView == 1",h5(strong("Stratified data:")), tableOutput("stratData")),
conditionalPanel(condition = "input.stratsView == 2",h5(strong("Stratified data:")), plotOutput("stratPlot"))
)
server <- function(input, output, session) {
dat <- reactive({
data.frame(
ID = c(1,1,2,2,2,2,3,3,3,3),
Period = c("2020-03", "2020-04", "2020-01", "2020-02", "2020-03", "2020-04", "2020-01", "2020-02", "2020-03", "2020-04"),
Values_1 = c(-6, 26, 36, 46, 56, 86, 100, 10, 20, 30),
Values_2 = c(-3, 13, 18, 23, 28, 43, 50, 5, 10, 15)
)
})
output$strat_values <- renderUI({
selectInput("strat_values",
"Variable to range-spread (col 1):",
choices = c("Values_1","Values_2"),
selected = c("Values_1"))
})
stratData <- function(){
req(input$strat_values)
filter_exp1 <- parse(text=paste0("Period", "==", "'","2020-04", "'"))
dat_1 <- reactive({dat() %>% filter(eval(filter_exp1))})
breaks <- seq(min(dat_1()[[input$strat_values]]), max(dat_1()[[input$strat_values]]), length.out = 6)
tmp <- dat() %>%
filter(eval(filter_exp1)) %>%
mutate(Range = cut(!!sym(input$strat_values), breaks=breaks, include.lowest=TRUE, right = TRUE, dig.lab = 5)) %>%
group_by(Range)
tmp <- tmp %>%
summarise(Count = n(),Values = sum(!!sym("Values_2"))) %>%
complete(Range, fill = list(Count = 0,Values = 0)) %>%
ungroup %>%
mutate(Count_pct = Count/sum(Count)*100, Values_pct = Values/sum(Values)*100) %>%
dplyr::select(everything(), Count, Count_pct, Values, Values_pct) %>%
bind_rows(summarise_all(., ~(if(is.numeric(.)) sum(.) else "Total")))
Count <- tmp %>% pull(Count)
Range <- tmp %>% pull(Range)
list(data = tmp,
Range = Range[-length(Range)],
Count = as.data.frame(Count[-length(Count)]))
}
output$stratData <- renderTable({stratData()$data})
output$stratPlot <- renderPlot({
x <- factor(stratData()$Range, levels = c(stratData()$Range))
y <- as.matrix(stratData()$Count)
ggplot(stratData()$Count,aes(x,y)) +
geom_bar(stat="identity") +
labs(x = "Ranges") +
geom_text(aes(y = y + sign(y)/4,label = y))
})
}
shinyApp(ui, server)
Code 2:
stratData <- function(){
req(input$strat_values)
filter_exp1 <- parse(text=paste0("Period", "==", "'","2020-04", "'"))
dat_1 <- reactive({dat() %>% filter(eval(filter_exp1))})
breaks <- seq(min(dat_1()[[input$strat_values]]), max(dat_1()[[input$strat_values]]), length.out = 6)
tmp <- dat() %>%
filter(eval(filter_exp1)) %>%
mutate(sumvar = cut(!!sym(input$strat_values), breaks=breaks, include.lowest=TRUE, right = TRUE, dig.lab = 5)) %>%
group_by(sumvar)
tmp <- tmp %>%
summarise(Count = n(),Values = sum(!!sym("Values_2"))) %>%
complete(sumvar, fill = list(Count = 0,Values = 0)) %>%
ungroup %>%
mutate(Count_pct = Count/sum(Count)*100, Values_pct = Values/sum(Values)*100) %>%
dplyr::select(everything(), Count, Count_pct, Values, Values_pct) %>%
bind_rows(summarise_all(., ~(if(is.numeric(.)) sum(.) else "Total")))
names(tmp)[1] <- paste(input$strat_values, " Range")
Count <- tmp %>% pull(Count)
# Range <- tmp %>% pull(Range)
list(data = tmp,
# Range = Range[-length(Range)],
Count = as.data.frame(Count[-length(Count)]))
}
Resolved code:
Now with OP code correction and reflecting Stefan's comment for plot axis label reactivity; posting revised stratData() custom function where only one line was fixed (commented below) and the renderPlot() function where Stefan's axis-label solution is also commented:
stratData <- function(){
req(input$strat_values)
filter_exp1 <- parse(text=paste0("Period", "==", "'","2020-04", "'"))
dat_1 <- reactive({dat() %>% filter(eval(filter_exp1))})
breaks <- seq(min(dat_1()[[input$strat_values]]), max(dat_1()[[input$strat_values]]), length.out = 6)
tmp <- dat() %>%
filter(eval(filter_exp1)) %>%
mutate(Range = cut(!!sym(input$strat_values), breaks=breaks, include.lowest=TRUE, right = TRUE, dig.lab = 5)) %>%
group_by(Range)
tmp <- tmp %>%
summarise(Count = n(),Values = sum(!!sym("Values_2"))) %>%
complete(Range, fill = list(Count = 0,Values = 0)) %>%
ungroup %>%
mutate(Count_pct = Count/sum(Count)*100, Values_pct = Values/sum(Values)*100) %>%
dplyr::select(everything(), Count, Count_pct, Values, Values_pct) %>%
bind_rows(summarise_all(., ~(if(is.numeric(.)) sum(.) else "Total")))
names(tmp)[1] <- paste(input$strat_values, " Ranges")
Count <- tmp %>% pull(Count)
Range <- tmp %>% pull(var = 1) # var = 1 pulls left-most column from tmp dataframe
list(data = tmp,
Range = Range[-length(Range)],
Count = as.data.frame(Count[-length(Count)]))
}
output$stratPlot <- renderPlot({
x <- factor(stratData()$Range, levels = c(stratData()$Range))
y <- as.matrix(stratData()$Count)
ggplot(stratData()$Count,aes(x,y)) +
geom_bar(stat="identity") +
labs(x = paste(input$strat_values, " Ranges")) + # < Added line this per Stefan comment
geom_text(aes(y = y + sign(y)/4,label = y),
position = position_nudge(y = 0),
size = 5)
})

How to conditionally count the number of occurrences using dplyr?

In the below reproducible example, the user stratifies the elements of a data frame based on inputs for (A) point-in-time period and (B) which of the 2 columns of values to stratify.
I'm trying to count only those rows marked with an "N" in the "Flag" column in those circumstances where the user has selected to stratify the "Values_2" elements; otherwise the Flag column is ignored when the user selects to stratify the "Values_1" elements.
The below code works except for counting elements flagged "N" when "Values_2" is chosen. I commented out my attempt to count elements flagged "N"... because it produces non-sensical results.
I will also only sum those "Value_2" elements flagged with "N" but I can figure that one out.
The image at the bottom better explains the question.
Any suggestions?
library(shiny)
library(tidyverse)
library(shinyWidgets)
ui <-
fluidPage(
uiOutput("stratPeriod"),
uiOutput("stratValues"),
h5(strong("Raw data frame:")), tableOutput("rawData"),
h5(strong("Stratified data:")), tableOutput("stratData")
)
server <- function(input, output, session) {
dat <- reactive({
data.frame(
ID = c(1,1,2,2,2,2,3,3,3,3),
Period = c("2020-03", "2020-04", "2020-01", "2020-02", "2020-03", "2020-04", "2020-01", "2020-02", "2020-03", "2020-04"),
Values_1 = c(-6, 26, 36, 46, 56, 86, 100, 10, 20, 30),
Values_2 = c(-6, 13, 18, 46, 28, 43, 100, 10, 10, 30),
Flag = c("N","Y","Y","N","Y","Y","N","N","Y","N")
)
})
output$stratPeriod <- renderUI({
chc <- unique(na.omit(dat()[[2]]))
selectInput(inputId = "stratPeriod",
label = "Choose point-in-time:",
choices = chc,
selected = chc[1])
})
output$stratValues <- renderUI({
selectInput("stratValues",
"Choose values type to sum:",
choices = c("Values_1","Values_2"),
selected = c("Values_1")
)
})
output$rawData <- renderTable({dat()})
output$stratData <- renderTable({
req(input$stratValues)
req(input$stratPeriod)
filter_exp1 <- parse(text=paste0("Period", "==", "'",input$stratPeriod, "'"))
dat_1 <- reactive({dat() %>% filter(eval(filter_exp1))})
min <- custom_min(dat_1()[[input$stratValues]])
max <- custom_max(dat_1()[[input$stratValues]])
breaks <- if(any(is.infinite(c(min,max)))) c(0, 10) else seq(min, max, length.out = 6)
tmp <- dat() %>%
filter(eval(filter_exp1)) %>%
mutate(Range = cut(!!sym(input$stratValues), breaks=breaks, include.lowest=TRUE, right = TRUE, dig.lab = 5)) %>%
group_by(Range) %>%
summarise(Count = n(),Values = sum(!!sym(input$stratValues))) %>%
# summarise(Count = if_else(!!sym(input$stratValues) == "Values_1",n(),sum(dat()[[5]]=="N")),Values = sum(!!sym(input$stratValues))) %>%
complete(Range, fill = list(Count = 0,Values = 0)) %>%
ungroup %>%
mutate(Count_pct = Count/sum(Count)*100, Values_pct = Values/sum(Values)*100) %>%
dplyr::select(everything(), Count, Count_pct, Values, Values_pct) %>%
bind_rows(summarise_all(., ~(if(is.numeric(.)) sum(.) else "Total")))
tmp
})
}
shinyApp(ui, server)
I think the easiest way might be to change the renderTable() function to the following:
output$stratData <- renderTable({
req(input$stratValues)
req(input$stratPeriod)
filter_exp1 <- parse(text=paste0("Period", "==", "'",input$stratPeriod, "'"))
dat_1 <- reactive({dat() %>% filter(eval(filter_exp1))})
min <- custom_min(dat_1()[[input$stratValues]])
max <- custom_max(dat_1()[[input$stratValues]])
breaks <- if(any(is.infinite(c(min,max)))) c(0, 10) else seq(min, max, length.out = 6)
tmp <- dat() %>%
filter(eval(filter_exp1)) %>%
mutate(Range = cut(!!sym(input$stratValues), breaks=breaks, include.lowest=TRUE, right = TRUE, dig.lab = 5)) %>%
group_by(Range)
if(input$stratValues == "Values_2"){
tmp <- tmp %>%
filter(Flag == "N")
}
tmp <- tmp %>%
summarise(Count = n(),Values = sum(!!sym(input$stratValues))) %>%
complete(Range, fill = list(Count = 0,Values = 0)) %>%
ungroup %>%
mutate(Count_pct = Count/sum(Count)*100, Values_pct = Values/sum(Values)*100) %>%
dplyr::select(everything(), Count, Count_pct, Values, Values_pct) %>%
bind_rows(summarise_all(., ~(if(is.numeric(.)) sum(.) else "Total")))
tmp
})
In the code above, there is an if() condition that identifies whether stratValues is Values_2. If so, it filters the data to only include the "N" observations on Flag. Then, it continues with the rest of the analysis. This will work if both Values and Countare calculated only on the observations whereFlag == "N"`.

ddply stops with warning Error in str2lang(x) : <text>:2:0: unexpected end of input

Question
I have the following code of ddply where the inside function works well with a single element i in modelNames. However, when I run the entire code in ddply, it gives me error:
Error in str2lang(x) : <text>:2:0: unexpected end of input
1: ~
^
Do you have any idea what part of code may cause the issue?
Current Code
t <-
modelNames %>%
ddply('model', function(i){
print(i)
colnames <- names(d)
dep <-
models %>%
chain.filter('dep') %>%
filter(model == i) %>%
filter(dep == 1) %>%
.$variable
indep <-
models %>%
chain.filter('dep') %>%
filter(model == i) %>%
filter(indep == 1) %>%
.$variable
base <-
Reduce(intersect, list(indep, colnames))
interaction <-
expand.grid(base, base) %>%
mutate(
interaction = paste0(Var1, '*', Var2)
) %>%
.$interaction
interaction <-
Reduce(intersect, list(indep, interaction))
indep <-
c(base, interaction)
eq <-
paste(indep, collapse = ' + ') %>%
paste(dep, ., sep = ' ~ ') %>%
as.formula
s <-
lm(eq, d) %>%
summary(.) %>%
.$coefficient %>%
as.data.frame
r <-
lm(eq, d) %>%
summary(.) %>%
.$r.squared
n <- nobs(lm(eq, d))
t <- data.frame(
model = i,
variable = rownames(s),
estimate = s[, 1],
se = s[, 2],
group = 'Estimates'
) %>%
chain_stars(asterisk = c('', '', '\\textsuperscript{*}', '\\textsuperscript{**}')) %>%
rows_insert(tibble(variable = 'rsqr', estimate = as.character(easy.round4(r)), se = NA, group = 'Overall')) %>%
rows_insert(tibble(variable = 'obs', estimate = as.character(prettyNum(n, big.mark = ",", scientific = F)), se = NA, group = 'Overall')) %>%
gather(state, value, -c(group, variable))
t
}, .progress = 'text')

Error in eval(substitute(expr), envir, enclos) in Shiny R

I'm receiving the following error when trying to run a Shiny App I'm building. The error is:
Listening on http://........
Error in eval(substitute(expr), envir, enclos) :
incorrect length (0), expecting: 202
I've been modeling the base of my app after the movie-explorer example App. The data is fed in via CSV and is a 202 lines long dataframe.
UPDATE
After running through debugger I've found that the actual expression that causes the error is found within the %>% function. The error occurs after the following two lines of code are executed:
env[["_lhs"]] <- eval(lhs, parent, parent)
result <- withVisible(eval(quote(`_fseq`(`_lhs`)), env, env))
At this point in the code the variable values are:
lhs = companies
parent = Environment
env = Environment
Obviously, the code is expecting my dataframe but is receiving an empty set. Reason is unknown.
END UPDATE
SPECIFIC QUESTION: What am I doing wrong and how do I fix it?
my server.R file looks like:
library(shiny)
library(dplyr)
library(ggvis)
all_dat = read.csv("data/company_data.csv")
shinyServer(function(input, output, session) {
companies <- reactive({
# Filter the clicks, views, opens
clicks <- input$Clicks
pageviews <- input$Pageviews
opens <- input$Opens
engage_value <- input$Engage_Value
viewspermsg <- input$views_per_msg
clickspermsg <- input$clicks_per_msg
openspermsg <- input$opens_per_msg
# Apply Filters
d <- all_dat %>%
filter(
Clicks >= clicks,
Pageviews >= pageviews,
Opens >= opens,
Engage_Value >= engage_value,
views_per_msg >= viewspermsg,
clicks_per_msg >= clickspermsg,
opens_per_msg >= openspermsg
) %>%
arrange(Clicks)
# Optional: filter by Dive
if (input$Dive != "All") {
size <- paste0("%", input$Dive, "%")
d <- d %>% filter(Dive %like% dive)
}
# Optional: filter by Dive Family
if (input$Family != "All") {
family <- paste0("%", input$Family, "%")
d <- d %>% filter(Family %like% family)
}
# Optional: filter by Industry
if (input$Industry != "All") {
industry <- paste0("%", input$Industry, "%")
d <- d %>% filter(Industry %like% industry)
}
# Optional: filter by Dive Family
if (input$Size != "All") {
size <- paste0("%", input$Size, "%")
d <- d %>% filter(Size %like% size)
}
d <- as.data.frame(d)
d$Has_International <- character(nrow(d))
d$Has_International[d$Oscars == 0] <- "No"
d$Has_International[d$Oscars >= 1] <- "Yes"
#I don't know if I need this.
d
})
company_tooltip <- function(x) {
if (is.null(x)) return(NULL)
if (is.null(x$Unnamed..0)) return(NULL)
all_dat <- isolate(companies())
company <- all_dat[all_dat$Unnamed..0 == x$Unnamed..0, ]
paste0("<b>", company$Company, "</b><br>",
company$Industry, "<br>",
company$Size, " employees", "<br>",
company$Company_Type, "<br>",
round(company$Percent_New, digits=2), " % New Readers"
)
}
#reactive labels and graph aspects
vis <- reactive({
# Labels for axes
xvar_name <- names(axis_vars)[axis_vars == input$xvar]
yvar_name <- names(axis_vars)[axis_vars == input$yvar]
# Normally we could do something like props(x = ~BoxOffice, y = ~Reviews),
# but since the inputs are strings, we need to do a little more work.
xvar <- prop("x", as.symbol(input$xvar))
yvar <- prop("y", as.symbol(input$yvar))
companies %>%
ggvis(x = xvar, y = yvar) %>%
layer_points(size := 50, size.hover := 200,
fillOpacity := 0.2, fillOpacity.hover := 0.5,
stroke = ~Has_International, key := ~Unnamed..0) %>%
add_tooltip(company_tooltip, "hover") %>%
add_axis("x", title = xvar_name) %>%
add_axis("y", title = yvar_name) %>%
add_legend("stroke", title = "International Presence", values = c("Yes", "No")) %>%
scale_nominal("stroke", domain = c("Yes", "No"),
range = c("orange", "#aaa")) %>%
set_options(width = 500, height = 500)
})
vis %>% bind_shiny("plot1")
})
Solution: In the code where filters are setup, reference all lowercase variable names (input$dive), not the uppercase variable name as it originally appears in the initial data frame (input$Dive). So change input$Dive to input$dive.
The wrong way
# Optional: filter by Dive
if (input$Dive != "All") {
size <- paste0("%", input$Dive, "%")
d <- d %>% filter(Dive %like% dive)
}
The right way.
# Optional: filter by Dive
if (input$dive != "All") {
size <- paste0("%", input$dive, "%")
d <- d %>% filter(Dive %like% dive)
}

Resources