why my new var name show up as "... <- NULL" - r

I would like to creat a var named"AGEGROUP" for age group. I wrote following code. But it seems like the new variable name in the data set show up as "... <- NULL" instead of "AGEGROUP". Why? How should I fix this.
Here is my codes:
set.seed(12345)
AGE <- sample(0:110, 100, replace = TRUE)
Sample.data <-data.frame(AGE)
Sample.data <- Sample.data %>% dplyr::mutate(AGEGROUP <-cut(AGE,
right=FALSE,
breaks = c(0,1,12,17,64,1000),
labels = c("Infant(0.083-1.999 yrs)","Child(2-12.999 yrs)", "Adolescent(13-17.999 yrs)","Adult(18-64.999 yrs.)","Elderly(65-199 yrs)")))

There seems to be a <- (assignment) instead of "=" (parameter match):
library("dplyr")
set.seed(12345)
AGE <- sample(0:110, 100, replace = TRUE)
Sample.data <-data.frame(AGE)
Sample.data <- Sample.data %>%
dplyr::mutate(AGEGROUP = cut(
AGE,
right = FALSE,
breaks = c(0, 1, 12, 17, 64, 1000),
labels = c(
"Infant(0.083-1.999 yrs)",
"Child(2-12.999 yrs)",
"Adolescent(13-17.999 yrs)",
"Adult(18-64.999 yrs.)",
"Elderly(65-199 yrs)"
)
))

Related

Is there a way to create a network of word associations using a bi-partite network analysis in R?

I have a text file with words from historical accounts and I want to visualise the species and frequency of words associated with them.
So far I have tried using the following code with a txt file of all the historical documents in one doc but want to ask if there is specific formatting of a csv to then input into R for a bipartite network graph:
"""library(ggraph)
library(ggplot2)
library(dplyr)
library(pdftools)
library(tm)
library(readtext)
library(tidytext)
library(igraph)
library(tidyr)
library(FactoMineR)
library(factoextra)
library(flextable)
library(GGally)
library(ggdendro)
library(network)
library(Matrix)
library(quanteda)
library(stringr)
library(quanteda.textstats)
options(stringsAsFactors = F)
options(scipen = 999)
options(max.print=1000)
# Read in text--------
wordbase <- readtext("mq_bird_stories.txt")
# List of extra words to remove---------
extrawords <- c("the", "can", "get", "Ccchants", "make", "making", "house", "torn", "tree", "man", "however", "upon", "instructs", "wife", "coming","without", "mother", "versions","variant", "version", "thus", "got","throws", "are", "has", "already", "asks", "sacra", "can", "brings", "one", "look", "sees", "tonaheiee", "wants", "later",
"dont", "even", "may", "but", "will", "turn", "sing", "swallows", "alba", "gives", "find", "other","tonaheieee", "away","day","comes","another",
"much", "first", "but", "see", "new", "back","goes", "go","songs", "returns", "take","takes","come",
"many", "less", "now", "well", "taught", "like", "puts", "slits", "sends", "tell","tells","open","mentions",
"often", "every", "said", "two", "and", "handsome", "husband", "bring", "lives","gets", "von", "den", "steinen", "handy")
# Clean the data-------
darwin <- wordbase %>%
paste0(collapse = " ") %>%
stringr::str_squish() %>%
stringr::str_remove_all("\\(") %>%
stringr::str_remove_all("\\)") %>%
stringr::str_remove_all("!") %>%
stringr::str_remove_all(",") %>%
stringr::str_remove_all(";") %>%
stringr::str_remove_all("\\?") %>%
stringr::str_split(fixed(".")) %>%
unlist() %>%
tm :: removeWords(extrawords) %>%
paste0(collapse = " ")
# One method for calculating frequencies of bigrams------
# Process into a table of words
darwin_split <- darwin %>%
as_tibble() %>%
tidytext::unnest_tokens(words, value)
# Create data frame of bigrams-------
darwin_words <- darwin_split %>%
dplyr::rename(word1 = words) %>%
dplyr::mutate(word2 = c(word1[2:length(word1)], NA)) %>%
na.omit()
# Calculate frequency of bigrams-----
darwin2grams <- darwin_words %>%
dplyr::mutate(bigram = paste(word1, word2, sep = " ")) %>%
dplyr::group_by(bigram) %>%
dplyr::summarise(frequency = n()) %>%
dplyr::arrange(-frequency)
# Define stopwords
stps <- paste0(tm::stopwords(kind = "en"), collapse = "\\b|\\b")
# Remove stopwords from bigram table
darwin2grams_clean <- darwin2grams %>%
dplyr::filter(!str_detect(bigram, stps))
# Another method for calculating frequencies of bigrams
# Clean corpus
darwin_clean <- darwin %>%
stringr::str_to_title()
# Tokenize corpus----
darwin_tokzd <- quanteda::tokens(darwin_clean)
# Extract bigrams------
BiGrams <- darwin_tokzd %>%
quanteda::tokens_remove(stopwords("en")) %>%
quanteda::tokens_select(pattern = "^[A-Z]",
valuetype = "regex",
case_insensitive = FALSE,
padding = TRUE) %>%
quanteda.textstats::textstat_collocations(min_count = 1, tolower = FALSE)
# read in and process text
darwinsentences <- darwin %>%
stringr::str_squish() %>%
tokenizers::tokenize_sentences(.) %>%
unlist() %>%
stringr::str_remove_all("- ") %>%
stringr::str_replace_all("\\W", " ") %>%
stringr::str_squish()
# inspect data
head(darwinsentences)
darwincorpus <- Corpus(VectorSource(darwinsentences))
# clean corpus-----
darwincorpusclean <- darwincorpus %>%
tm::tm_map(removeNumbers) %>%
tm::tm_map(tolower) %>%
tm::tm_map(removeWords, stopwords()) %>%
tm::tm_map(removeWords, extrawords)
# create document term matrix
darwindtm <- DocumentTermMatrix(darwincorpusclean, control=list(bounds = list(global=c(1, Inf)), weighting = weightBin))
# convert dtm into sparse matrix
darwinsdtm <- Matrix::sparseMatrix(i = darwindtm$i, j = darwindtm$j,
x = darwindtm$v,
dims = c(darwindtm$nrow, darwindtm$ncol),
dimnames = dimnames(darwindtm))
# calculate co-occurrence counts
coocurrences <- t(darwinsdtm) %*% darwinsdtm
# convert into matrix
collocates <- as.matrix(coocurrences)
# inspect size of matrix
ncol(collocates)
#provide some summary stats
summary(rowSums(collocates))
#visualising collocations
# load function for co-occurrence calculation
source("https://slcladal.github.io/rscripts/calculateCoocStatistics.R")
# define term
coocTerm <- "pigeon"
# calculate co-occurrence statistics
coocs <- calculateCoocStatistics(coocTerm, darwinsdtm, measure="LOGLIK")
# inspect results
coocs[1:50]
coocdf <- coocs %>%
as.data.frame() %>%
dplyr::mutate(CollStrength = coocs,
Term = names(coocs)) %>%
dplyr::filter(CollStrength > 0)
###Make graph - visualize association strengths------
ggplot(coocdf, aes(x = reorder(Term, CollStrength, mean), y = CollStrength)) +
geom_point() +
coord_flip() +
theme_bw() +
labs(y = "")
##network
net = network::network(collocates_redux,
directed = FALSE,
ignore.eval = FALSE,
names.eval = "weights")
# vertex names
network.vertex.names(net) = rownames(collocates_redux)
# inspect object
net
ggnet2(net,label = TRUE,
label.size = 4,
alpha = 0.2,
size.cut = 3,
edge.alpha = 0.3) +
guides(color = FALSE, size = FALSE)"""
I'd suggest taking a look at the netCoin package. If you can transform your data into nodes and links data frames, then you can easily get a high quality network visualization:
#Example of links data frame
links <-
data.frame(
matrix(
c(
"Person A","Account 1", "not link",
"Person A","Account 2", "link",
"Person B","Account 2", "link",
"Person B","Account 3", "not link",
"Person B","Account 4", "link",
"Person C","Account 4", "link"
),
nrow = 6,
ncol = 3,
byrow = TRUE,
dimnames = list(NULL,
c("Source", "Target", "other_links_column"))
),
stringsAsFactors = FALSE
)
#Example of nodes data frame
nodes <-
data.frame(
matrix(
c(
"Person A","person",
"Person B","person",
"Person C","person",
"Account 1", "account",
"Account 2", "account",
"Account 3", "account",
"Account 4", "account"
),
nrow = 7,
ncol = 2,
byrow = TRUE,
dimnames = list(NULL,
c("name", "other_nodes_column"))
),
stringsAsFactors = FALSE
)
install.packages("netCoin") #may need to install the netCoin package
library(netCoin)
?netCoin #displays netCoin Help to see all the function options
graph_df <- netCoin(nodes = nodes, #Data frame of unique nodes and their attributes #Must contain name column
links = links, #Data frame of links and their attributes #Must contain Source and Target columns
cex = 1.25, #Font size
color = "other_nodes_column", #Column in node data frame to determine node color
shape = "other_nodes_column", #Column in node data frame to determine node shape
main = "This is the title of my visualization", #Visualization title
controls = 1:5, #Controls that will be shown in the visualization (maximum of 5)
dir = "folder-with-viz-output") #Output folder for the visualization #Entire folder should be exported as a zip file
plot(graph_df) #Command to display the visualization

name variable at the same time using complete

I would like to get a sub total by age group. The sample data and the codes are:
set.seed(12345)
#create a numeric variable Age
AGE <- sample(0:110, 100, replace = TRUE)
# Creat Data fame
Sample.data <-data.frame(AGE)
summary_data<- Sample.data %>%
group_by(grp = cut(
AGE,
breaks=c(-Inf, 0,0.001, 0.083, 2, 13, 65,1000),
right=TRUE,
labels = c("Foetus(0 yr)","Neonate (0.001 - 0.082 yr)","Infant(0.083-1.999 yrs)","Child(2-12.999 yrs)", "Adolescent(13-17.999 yrs)","Adult(18-64.999 yrs.)","Elderly(65-199 yrs)")
)) %>% summarise("Total People" = n())%>% complete(grp = levels(grp), fill = list("Total People = 0))
which gave the results that looks like this:
Is it possible to label grp as "Age Group"? and sort it by age?
I tried to define the name as follow and the results are strange. What did I do wrong?
summary_data<- Sample.data %>%
group_by("Age Group" = cut(
AGE,
breaks=c(-Inf, 0,0.001, 0.083, 2, 13, 65,1000),
right=TRUE,
labels = c("Foetus(0 yr)","Neonate (0.001 - 0.082 yr)","Infant(0.083-1.999 yrs)","Child(2-12.999 yrs)", "Adolescent(13-17.999 yrs)","Adult(18-64.999 yrs.)","Elderly(65-199 yrs)")
)) %>% summarise("Total People" = n())%>% complete("Age Group" = levels("Age Group"), fill = list("Total People" = 0))
The new results are:
The variable now has name "Age Group", but table doesn't fill 0 for the age category that do not have observation. What should I do.
The ideal results should look like this:
We can change the double quotes to backquotes in levels to evaluate the column in complete. The column name is non-standard i.e. it includes a space.
...
%>%
complete("Age Group" = levels(`Age Group`), fill = list("Total People" = 0))
# A tibble: 7 x 2
# `Age Group` `Total People`
# <chr> <dbl>
#1 Adolescent(13-17.999 yrs) 14
#2 Adult(18-64.999 yrs.) 37
#3 Child(2-12.999 yrs) 2
#4 Elderly(65-199 yrs) 46
#5 Foetus(0 yr) 1
#6 Infant(0.083-1.999 yrs) 0
#7 Neonate (0.001 - 0.082 yr) 0
If we want to arrange
Sample.data %>%
group_by("Age Group" = cut(
AGE,
breaks=c(-Inf, 0,0.001, 0.083, 2, 13, 65,1000),
right=TRUE,
labels = c("Foetus(0 yr)","Neonate (0.001 - 0.082 yr)","Infant(0.083-1.999 yrs)","Child(2-12.999 yrs)", "Adolescent(13-17.999 yrs)","Adult(18-64.999 yrs.)","Elderly(65-199 yrs)")
)) %>%
summarise("Total People" = n()) %>%
complete("Age Group" = levels(`Age Group`), fill = list("Total People" = 0)) %>%
arrange(`Total People`)

how to built a new data with summarize and cut command for each age group

I want to build new data (age_summary) with a total number of people by age group. I would like to use "cut" and My codes are:
set.seed(12345)
#create a numeric variable Age
AGE <- sample(0:110, 100, replace = TRUE)
# Creat Data fame
Sample.data <-data.frame(AGE)
age_summary <- Sample.data %>% summarize(group_by(Sample.data,
cut(
AGE,
breaks=c(0,0.001, 0.083, 2, 13, 65,1000),
right=TRUE,
labels = c("Foetus(0 yr)","Neonate (0.001 - 0.082 yr)","Infant(0.083-1.999 yrs)","Child(2-12.999 yrs)", "Adolescent(13-17.999 yrs)","Adult(18-64.999 yrs.)","Elderly(65-199 yrs)")
),"Total people" = n())
)
However my codes do not work. I am not sure what went wrong. Any suggestion on how to solve this?
Add:
I was able to get results that look like this:
is it possible for me to achieve something looks like this:
Here is what I get with adorn_totals(.) on a new data set. the total people looks OK, but the ave-age looks strange.
Any idea?
If we remove the summarise wrapping around the group_by, we can find the issue more easily. Here, the cut labels and breaks have different lengths, which can be changed if we add -Inf or Inf in breaks
library(dplyr)
Sample.data %>%
group_by(grp = cut(AGE,
breaks=c(-Inf, 0,0.001, 0.083, 2, 13, 65,1000),
right=TRUE,
labels = c("Foetus(0 yr)",
"Neonate (0.001 - 0.082 yr)","Infant(0.083-1.999 yrs)","Child(2-12.999 yrs)", "Adolescent(13-17.999 yrs)",
"Adult(18-64.999 yrs.)","Elderly(65-199 yrs)")
)) %>%
summarise(TotalPeople = n())
If we need to create a row with different functions applied on different columns, use add_row
library(tibble)
library(tidyr)
Sample.data %>%
group_by(grp = cut( AGE, breaks=c(-Inf, 0,0.001, 0.083, 2, 13, 65,1000),
right=TRUE, labels = c("Foetus(0 yr)","Neonate (0.001 - 0.082 yr)","Infant(0.083-1.999 yrs)","Child(2-12.999 yrs)",
"Adolescent(13-17.999 yrs)","Adult(18-64.999 yrs.)","Elderly(65-199 yrs)") )) %>%
summarise(TotalPeople = n(), Ave_age=mean(AGE))%>%
complete(grp = levels(grp), fill = list(TotalPeople = 0)) %>%
add_row(grp = "Total", TotalPeople = sum(.$TotalPeople),
Ave_age = mean(.$Ave_age, na.rm = TRUE))

View venn.diagram in RStudio viewer (not just write to file) using VennDiagram?

Using the VennDiagram package, we can make a venn diagram like so with the venn.diagram() function like so:
library(tidyverse)
library(hrbrthemes)
library(tm)
library(proustr)
# Load dataset from github
data <- read.table("https://raw.githubusercontent.com/holtzy/data_to_viz/master/Example_dataset/14_SeveralIndepLists.csv", header=TRUE)
to_remove <- c("_|[0-9]|\\.|function|^id|script|var|div|null|typeof|opts|if|^r$|undefined|false|loaded|true|settimeout|eval|else|artist")
data <- data %>% filter(!grepl(to_remove, word)) %>% filter(!word %in% stopwords('fr')) %>% filter(!word %in% proust_stopwords()$word)
# library
library(VennDiagram)
#Make the plot
venn.diagram(
x = list(
data %>% filter(artist=="booba") %>% select(word) %>% unlist() ,
data %>% filter(artist=="nekfeu") %>% select(word) %>% unlist() ,
data %>% filter(artist=="georges-brassens") %>% select(word) %>% unlist()
),
category.names = c("Booba (1995)" , "Nekfeu (663)" , "Brassens (471)"),
filename = 'venn.png',
output = TRUE ,
imagetype="png" ,
height = 480 ,
width = 480 ,
resolution = 300,
compression = "lzw",
lwd = 1,
col=c("#440154ff", '#21908dff', '#fde725ff'),
fill = c(alpha("#440154ff",0.3), alpha('#21908dff',0.3), alpha('#fde725ff',0.3)),
cex = 0.5,
fontfamily = "sans",
cat.cex = 0.3,
cat.default.pos = "outer",
cat.pos = c(-27, 27, 135),
cat.dist = c(0.055, 0.055, 0.085),
cat.fontfamily = "sans",
cat.col = c("#440154ff", '#21908dff', '#fde725ff'),
rotation = 1
)
This results in a .png written to the working directly.
How can it instead be viewed in the RStudio viewer pane, and also used in RMarkdown docs etc (i.e. just in the same way a regular ggplot or base plots would be viewed)?
Also note, the same question applies to any of the examples found in the ?
venn.diagram documentation (they all seem to write to file instead of display in the RStudio viewer)
This should also do the job. I deleted the arguments for readability:
...
plt <- venn.diagram(
filename = NULL,
cex = 1,
cat.cex = 1,
lwd = 2,
)
grid::grid.draw(plt)
From ?venn.diagram
filename
Filename for image output, or if NULL returns the grid object itself
It seems, you can control almost anything. Again the docs:
... A series of graphical parameters tweaking the plot. See below for
details Details
Argument Venn Sizes Class Description
cex 1,2,3,4,5 numeric Vector giving the size for each area label (length = 1/3/7/15 based on set-number)
Thus we need to be able to display grid objects. plot() and print() don't do this job (it seems there is not print.grid()).
I usually do:
library(VennDiagram)
set.seed(1)
list1 <- list(A=sample(LETTERS, 12), B=sample(LETTERS, 12))
venn1 <- venn.diagram(list1, filename = NULL)
grid.newpage()
grid.draw(venn1)
I think it still writes a log file into the working directory, but not the graph.
You can put two diagrams side by side like this:
library(gridExtra)
set.seed(2)
list2 <- list(A=sample(LETTERS, 16), B=sample(LETTERS, 12))
venn2 <- venn.diagram(list2, filename = NULL)
grid.arrange(gTree(children=venn1),
gTree(children=venn2),
ncol=2)
Created on 2020-04-23 by the reprex package (v0.3.0)
I figured out a way - there may be better way(s). This involves writing to tempfile() instead of a file in the working directory and then reading it in with a few extra lines of code
Note: the only changes to the original code are the addition of
1 extra line at the start temp_file <- tempfile()
the rewriting of filename = 'venn.png' into filename = temp_file
3 extra lines at the bottom
# Libraries
library(tidyverse)
library(hrbrthemes)
library(tm)
library(proustr)
# Load dataset from github
data <- read.table("https://raw.githubusercontent.com/holtzy/data_to_viz/master/Example_dataset/14_SeveralIndepLists.csv", header=TRUE)
to_remove <- c("_|[0-9]|\\.|function|^id|script|var|div|null|typeof|opts|if|^r$|undefined|false|loaded|true|settimeout|eval|else|artist")
data <- data %>% filter(!grepl(to_remove, word)) %>% filter(!word %in% stopwords('fr')) %>% filter(!word %in% proust_stopwords()$word)
# library
library(VennDiagram)
temp_file <- tempfile()
#Make the plot
venn.diagram(
x = list(
data %>% filter(artist=="booba") %>% select(word) %>% unlist() ,
data %>% filter(artist=="nekfeu") %>% select(word) %>% unlist() ,
data %>% filter(artist=="georges-brassens") %>% select(word) %>% unlist()
),
category.names = c("Booba (1995)" , "Nekfeu (663)" , "Brassens (471)"),
filename = temp_file,
output = TRUE ,
imagetype="png" ,
height = 480 ,
width = 480 ,
resolution = 300,
compression = "lzw",
lwd = 1,
col=c("#440154ff", '#21908dff', '#fde725ff'),
fill = c(alpha("#440154ff",0.3), alpha('#21908dff',0.3), alpha('#fde725ff',0.3)),
cex = 0.5,
fontfamily = "sans",
cat.cex = 0.3,
cat.default.pos = "outer",
cat.pos = c(-27, 27, 135),
cat.dist = c(0.055, 0.055, 0.085),
cat.fontfamily = "sans",
cat.col = c("#440154ff", '#21908dff', '#fde725ff'),
rotation = 1
)
# https://stackoverflow.com/a/20909108/5783745
library(png)
img <- readPNG(temp_file)
grid::grid.raster(img)

Shiny App: Error in filter_impl: Result must have length 4090, not 0

Trying to run a shiny app, but keep getting the error: Error in filter_impl: Result must have length 4090, not 0
I've tried:
debugging by removing individual filters to try isolate the issue.
using dplyr::filter to force dplr's filter
ensured all filters are in a reactive function
checked whether it was an issue of sharing inputs between ui.R and server.r
checked whether it is caused by a previous df transformation.
Spent about 3 hours trying to find the cause, with no success.
Can you please help?
Server.R
rm(list = ls())
library(shiny)
library(tidyverse)
library(shiny)
library(ggplot2)
library(singer)
library(ggvis)
library(dplyr)
# Set Up DataFrames
data(package = "singer")
data(singer_locations)
sdf <- singer_locations %>% filter(year != 0) # filter out songs with missing years for simplicity
sdf %>% skim() %>% kable() # Check to see missing and incomplete values
sdf <- sdf %>% filter(complete.cases(.)) # filter out songs with missing observations for simplicity
sdf %>% skim() %>% kable() # Check to see if missing and incomplete values have been ignored
sdf <- sdf %>% select(
track_id, title, song_id, release, artist_id, artist_name, year, duration,
artist_hotttnesss, artist_familiarity, name, city, longitude, latitude
)
# add new columns with rounded data (for nicer graphs later)
sdf$latitude_rounded <- round(sdf$latitude, 0)
sdf$longitude_rounded <- round(sdf$longitude, 0)
sdf$duration_rounded <- round(sdf$duration, 0)
# Add song_popularity & very_popular_song columns
pops <- sdf$artist_hotttnesss + sdf$artist_familiarity
sdf$artist_popularity <- round(pops, 0)
sdf$very_popular_song <- round(sdf$artist_popularity)
sdf$very_popular_song[sdf$very_popular_song < 1] <- "No"
sdf$very_popular_song[sdf$very_popular_song >= 1] <- "Yes"
# Select() relevant variables so they can be passed into server below (without having to use df[,"VAR"])
songs_list <- sdf %>% select(
track_id, title, song_id, release, artist_id, artist_name, year, duration_rounded, duration,
artist_hotttnesss, artist_familiarity, name, city, latitude_rounded, longitude_rounded, longitude,
latitude, artist_popularity, very_popular_song
)
#axis_variables <- reactive({
axis_variables <- c(
"Length of Song (Seconds)" = "duration_rounded",
"Rating" = "artist_hotttnesss",
"Rating" = "artist_familiarity",
"Year" = "year",
"Popularity Rating" = "artist_popularity"
)
################################### SHINY SERVER #########################################
function(input, output) {
songs <- reactive({ # Create Reactive Filtering Component
duration_s <- input$duration_s
artist_hotttnesss_s <- input$artist_hotttnesss_s
artist_familiarity_s <- input$artist_familiarity_s
latitude_s <- input$latitude_s
longitude_s <- input$longitude_s
year_s <- input$year_s
artist_popularity_s <- input$artist_popularity_s
# Apply filters
songs_df <- songs_list %>%
dplyr::filter(
duration_rounded >= duration_s,
artist_hotttnesss >= artist_hotttnesss_s,
artist_familiarity >= artist_familiarity_s,
latitude_rounded >= latitude_s,
longitude_rounded >= longitude_s,
year >= year_s,
artist_popularity >= artist_popularity_s
) %>%
arrange(duration_rounded)
# filter by city option
if (input$city_in != "All") {
city_in_temp <- paste0("%", input$city_in, "%")
songs_df <- songs_df %>% dplyr::filter(songs_df$city %like% city_in_temp)
}
# filter by artist_name option
if (input$artist_name_in != "" && !is.null(input$artist_name_in)) {
artist_name_temp <- paste0("%", input$artist_name_in, "%")
songs_df <- songs_df %>% dplyr::filter(songs_df$artist_name %like% artist_name_temp)
}
songs_df <- as.data.frame(songs_df)
songs_df # return df
})
# search fuction
song_search <- function(s) {
if (is.null(s)) return(NULL)
if (is.null(s$track_id)) return(NULL)
# Isolate the given ID
songs_df <- isolate(songs())
temp_song <- songs_df[songs_df$track_id == s$track_id, ]
paste0("<b>", temp_song$artist_name, "</b><br>",
temp_song$year, "<br>",
"popularity ", format(temp_song$artist_popularity, big.mark = ",", scientific = FALSE)
)
}
# A reactive expression with the ggvis plot
vis <- reactive({
# setting variablex & variabley (input names are type str)
variablex <- prop("x", as.symbol(input$variablex))
variabley <- prop("y", as.symbol(input$variabley))
# Lables for axes
xvar_name <- names(axis_variables)[axis_variables == input$variablex]
yvar_name <- names(axis_variables)[axis_variables == input$variabley]
songs %>%
ggvis(x = variablex, y = variabley) %>%
layer_points(size := 50, size.hover := 200,
fillOpacity := 0.2, fillOpacity.hover := 0.5,
stroke = ~artist_popularity, key := ~artist_name) %>%
add_tooltip(song_search, "hover") %>%
add_axis("x", title = xvar_name) %>%
add_axis("y", title = yvar_name) %>%
add_legend("stroke", title = "Very Popular", 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")
output$songs_selected <- renderText({ nrow(songs()) })
}
Ui.R
rm(list = ls())
library(tidyverse)
library(shiny)
library(ggplot2)
library(singer)
library(ggvis)
library(dplyr)
#axis_variables <- reactive({
axis_variables <- c(
"Length of Song (Seconds)" = "duration_rounded",
"Hotness Rating" = "artist_hotttnesss",
"Familiarity Rating" = "artist_familiarity",
"Year" = "year",
"Popularity Rating" = "artist_popularity"
)
# Define UI for application that draws a histogram
shinyUI(fluidPage(
shinythemes::themeSelector(),
titlePanel("Artist & Song Data"),
fluidRow(
column(3,
wellPanel(
h4("Filter By"),
# Slider Options for Data Exploration
sliderInput("duration_s", "Minimum duration of song (seconds)", 10, 500, 100, step = 10),
sliderInput("year_s", "Year released", 1900, 2018, value = c(1980, 2018)),
sliderInput("artist_hotttnesss_s", "Ranking / 10 for popularity", 0, 2, 0, step = 0.1),
sliderInput("artist_familiarity_s", "Ranking / 10 for familiarity", 0, 2, 0, step = 0.1),
sliderInput("artist_popularity", "Ranking / 10 for familiarity", 0, 2, 0, step = 0.1),
# Filter by custom input condition
textInput("city_in", "Name of the city"),
textInput("artist_name_in", "Artist's name contains (e.g Pink f)")
),
wellPanel(
selectInput("variablex", "X-axis", axis_variables, selected = "year"),
selectInput("variabley", "Y-axis", axis_variables, selected = "duration_rounded")
)
),
column(9,
ggvisOutput("plot1"),
wellPanel(
span("Degrees of Freedom",
textOutput("songs_selected")
)
)
)
)
It looks like you are filtering using data created by input$XXX. Try to put req(input$XXX, req(input$YYY, ...) at the beginning of your reactive element(s).
Also read this tweet about starting with rm(list = ls()).

Resources