Shiny Dashboard with plot - shiny

I am learning some shiny in order to do a dashboard. I have an idea. I want to create a dashboard that select from an selectinput a variable, group by such variable and plot a barplot or histogram of the total of that variable.
I have generated a sample dataset to generate what I need, however I can´t get what I need.
The UI code is the next one:
library(shiny)
shinyUI(fluidPage(
titlePanel("Demo dashboard"),
sidebarLayout(
sidebarPanel(
selectInput("variable",
"group by",
choices = c("City","Country")
)
),
mainPanel(
plotOutput("distPlot")
)
)
))
The server code is the next one, Here I aggregate by the variable that is the input and plot the total
library(shiny)
library(dplyr)
shinyServer(function(input, output) {
output$distPlot <- renderPlot({
sample<-tbl_df(data.frame(c("City1","City2","City3","City1","City2","City3","City2","City3"),
c("A","B","C","D","D","A","A","B"),
c(12,14,15,12,12,14,8,10)))
colnames(sample)<-c("City","Country","Amount")
df1<-sample%>%group_by(input$variable)%>%
summarise(total=sum(Amount))
sample%>%group_by(input$variable)%>%summarise(total=sum(Amount))
x<- df1$total
hist(x)
})
})
A screen capture of my result is the next:
however this is not the expected result. I can´t get the histogram required

The problem is your usage of dplyr:
Your original code doesn't evaluate input$variable to group by city, rather tries to group by a non-existing column called `input$variable`:
sample %>%
group_by(input$variable) %>%
summarise(total=sum(Amount))
Result:
# # A tibble: 1 x 2
# `input$variable` total
# <chr> <dbl>
# 1 City 97
You can check this yourself easily by adding either a print statement after the statement (e.g.: print(df1)) or adding a browser() before the statement.
This behaviour is because dplyr uses non-standard-evaluation by default. You can read up more about that here.
To use standard (programmable) evaluation you need to unquote input$variable so that the value is passed to dplyr. In the current version you can do that using a combination of !! and sym.
Example:
sample %>%
group_by(!!sym(input$variable)) %>%
summarise(total=sum(Amount))
Result:
# # A tibble: 3 x 2
# City total
# <fct> <dbl>
# 1 City1 24
# 2 City2 34
# 3 City3 39
Histogram:
Edit: Some more explanation: group_by doesn’t evaluate its input, but rather it quotes it: That's why you're getting `input$variable` as a column name.
On the other hand: the sym function turns the actual value of input$variable into a symbol, then !! can be used to remove the quoting:
What works in dplyr is if you don't have quotes around the input, so: group_by(City)
Let's see what happens step by step:
sym(input$variable) returns "City". group_by("City") would still not work because the input has quoting around it!
That's why we need to use !!: !! sym(input$variable) returns City without quotes. So the expression evaluates to group_by(City), and thus will work as expected.

Related

How to update fillColor palette to selected input in shiny map?

I am having trouble transitioning my map from static to reactive so a user can select what data they want to look at. Somehow I'm not successfully connecting the input to the dataframe. My data is from a shapefile and looks roughly like this:
NAME Average Rate geometry
1 Alcona 119.7504 0.1421498 MULTIPOLYGON (((-83.88711 4...
2 Alger 120.9212 0.1204398 MULTIPOLYGON (((-87.11602 4...
3 Allegan 128.4523 0.1167062 MULTIPOLYGON (((-85.54342 4...
4 Alpena 114.1528 0.1410852 MULTIPOLYGON (((-83.3434 44...
5 Antrim 124.8554 0.1350004 MULTIPOLYGON (((-84.84877 4...
6 Arenac 127.8809 0.1413534 MULTIPOLYGON (((-83.7555 43...
In the server section below, you can see that I tried to use reactive to get the selected variable and when I write print(select) it does print the correct variable name, but when I try to put it into the colorNumeric() function it's clearly not being recognized. The map I get is all just the same shade of blue instead of different shades based on the value of the variable in that county.
ui <- fluidPage(
fluidRow(
selectInput(inputId="var",
label="Select variable",
choices=list("Average"="Average",
"Rate"="Rate"),
selected=1)
),
fluidRow(
leafletOutput("map")
)
)
server <- function(input, output, session) {
# Data sources
counties <- st_read("EITC_counties.shp") %>%
st_transform(crs="+init=epsg:4326")
counties_clean <- select(counties, NAME, X2020_Avg., X2020_Takeu)
counties_clean <- counties_clean %>%
rename("Average"="X2020_Avg.",
"Rate"="X2020_Takeu")
# Map
variable <- reactive({
input$var
})
output$map <- renderLeaflet({
select <- variable()
print(select)
pal <- colorNumeric(palette = "Blues", domain = counties_clean$select, na.color = "black")
color_pal <- counties_clean$select
leaflet()%>%
setView( -84.51, 44.18, zoom=5) %>%
addPolygons(data=counties_clean, layerId=~NAME,
weight = 1, smoothFactor=.5,
fillOpacity=.7,
fillColor=~pal(color_pal()),
highlightOptions = highlightOptions(color = "white",
weight = 2,
bringToFront = TRUE)) %>%
addProviderTiles(providers$CartoDB.Positron)
})
}
shinyApp(ui, server)
I've tried making the reaction into an event and also using the observe function using a leaflet proxy but it only produced errors. I also tried to skip the reactive definition and just put input$var directly into the palette (counties_clean$input$var), but it similarly did not show any color variation.
When I previously created a static map setting the palette using counties_clean$Average it came out correctly, but replacing Average with a user input is where I appear to be going wrong. Thanks in advance for any guidance you can provide and please let me know if I can share any additional clarification.
Unfortunately, your code is not reproducible without the data, but the mistake is most likely in this line
color_pal <- counties_clean$select
What this line does, is to extract a column named select from your data. This column is not existing, so it will return NULL.
What you want though, is to extract a column whose name is given by the content of select, so you want to try:
color_pal <- counties_clean[[select]]

how to select data based on a first selection - shiny app

I am new to using Shiny, I have read the tutorials, and a few questions on stacked overflow, but I think I"m still missing some key concept.
Basically I want users to first select a dataset.
Then based on that dataset they can select an OTU of interest.
Then I will display a plot and maybe a table.
I have the syntax for selecting the dataset correct, but how do I generate the choices of OTUs to select based on that ?
Any help appreciated.
thanks
ui <- fluidPage(
# Make a title to display in the app
titlePanel(" Exploring the Effect of Metarhizium on the Soil and Root Microbiome "),
# Make the Sidebar layout
sidebarLayout(
# Put in the sidebar all the input functions
sidebarPanel(
# drop down menu to select the dataset of interest
selectInput('dataset', 'dataset', names(abundance_tables)),
# drop down menu to select the OTU of interest
uiOutput("otu"),
#
br(),
# Add comment
p("For details on OTU identification please refer to the original publications")
),
# Put in the main panel of the layout the output functions
mainPanel(
plotOutput('plot')
# ,dataTableOutput("anova.tab")
)
)
)
server <- function(input, output){
# Return the requested dataset ----
datasetInput <- reactive({
switch(input$dataset)
})
#
dataset <- datasetInput()
# output otus to choose basaed on dataset selection
output$otu <- renderUI({
selectInput(inputId = "otu", label = "otu",
choices = colnames(dataset))
})
output$plot <- renderPlot({
#
dataset <- datasetInput()
otu <- input$otu
#dataset<-abundance_tables[[1]]
## melt and add sample metadata
df_annot<-merge(dataset,sample_metadata,by="row.names",all.x=T)
rownames(df_annot)<-df_annot[,1]
df_annot<-df_annot[,-1]
#
dfM<-melt(df_annot,id.vars = c("Location","Bean","Fungi","Insect"),value.name="abund")
# renaming Fungi level to metarhizium
levels(dfM$Fungi)<-c("Metarhizium","No Meta")
#
ggplot(subset(dfM, variable==otu),
aes(x=Insect,y=abund,fill=Fungi))+geom_boxplot()+facet_wrap(~Location,scales="free_y" )+
guides(fill=guide_legend("Metarhizium")) +
ggtitle(otu)
})
}
##
shinyApp(ui=ui,server=server)
Okay, I have made some fixes after some answers, but am now getting the following error.
Listening on http://127.0.0.1:5684
Warning: Error in .getReactiveEnvironment()$currentContext: Operation not allowed without an active reactive context. (You tried to do something that can only be done from inside a reactive expression or observer.)
Stack trace (innermost first):
41: .getReactiveEnvironment()$currentContext
40: .dependents$register
39: datasetInput
38: server [/Users/alisonwaller/Documents/Professional/Brock/Bidochka_Microbiome/shiny/Barelli_shiny.R#68]
1: runApp
Error in .getReactiveEnvironment()$currentContext() :
Operation not allowed without an active reactive context. (You tried to do something that can only be done from inside a reactive expression or observer.)
Yes you are really close. Just replace this line:
selectInput('otu', 'otu', uiOutput("otu")),
with this: uiOutput("otu"),
There's no need for SelectInput() here since that is in the renderUI in the server function.

Can typeahead be implemented over a dynamically changing dataframe using shinysky?

I am trying to populate a Typeahead box in Shiny, using the ShinySky package in R.
I'm trying to extend the example, where the data used to prepopulate the Typeahead is hardcoded into the textInput.typeahead function:
textInput.typeahead(
id="thti"
,placeholder="type 'name' or '2'"
,local=data.frame(name=c("name1","name2"),info=c("info1","info2")) #<- LOOK!
,valueKey = "name"
,tokens=c(1,2)
,template = HTML("<p class='repo-language'>{{info}}</p> <p class='repo-name'>{{name}}</p> <p class='repo-description'>You need to learn more CSS to customize this further</p>")
)
Having a local dataframe defined in the middle of the function is not what I would like to do, as the example has done here:
,local=data.frame(name=c("name1","name2"),info=c("info1","info2"))
I would like to supply an argument to local that is a reactive object, which is created elsewhere in Shiny.
So far I've been unable to do so.
Here's my strategy for attempting to populate the Lookhead options dynamically using reactivity:
1) Let the user subset a dataframe using a slider.
2) Set up the Lookahead to read in the subsetted dataframe, using something like ,local=subset(DF)
3) Hope that the Lookahead works as it's supposed to.
Seems simple enough? Here's a screenshot, where you can clearly see that the Lookhead doesn't appear underneath the user input of 111. Below is my code. Any help would be greatly appreciated.
library(shiny)
library(shinysky)
options(shiny.trace = F) # change to T for trace
DF <- data.frame(ID=c("111", "222", "333", "444"), info=c("info1", "info2", "info3", "info4"))
runApp(list(ui = pageWithSidebar(
headerPanel("This is a test"),
sidebarPanel(
helpText("I couldn't live without StackOverflow"),
sliderInput("range",
label = "Pick how many rows you want in your dataframe:",
min = 2, max = 4, value = 2, step=1),
helpText("After subsetting the dataframe using the controls above, can we make the Lookahead work?"),
textInput.typeahead(
id="thti"
,placeholder="type ID and info"
,local=subset(DF)
,valueKey = "ID"
,tokens=c(1,2)
,template = HTML("<p class='repo-language'>{{info}}</p> <p class='repo-name'>{{ID}}</p> <p class='repo-description'></p>"))
),
mainPanel(textOutput("text1"),
htmlOutput("text"),
tableOutput('table')
)
),
server = function(input, output, session) {
subsetDF <- reactive({ DF <- DF[1:input$range, ]
DF
})
output$text <- renderUI({
str <- paste("This is how many rows you've chosen for your dataframe:",
input$range)
HTML(paste(str, sep = '<br/>'))
})
output$table <- renderTable(subsetDF())
}
)
)

output computation in R using shiny [duplicate]

This question already has answers here:
How to calculate the number of occurrence of a given character in each row of a column of strings?
(14 answers)
Closed 7 years ago.
I am trying to find a pattern of "GC" in different genes(strings) with a user interface using Shiny.I am using grep command of R to find the pattern but I am not able to get the correct output.Below is the code of UI.R
library(shiny)
setwd("C:/Users/ishaan/Documents/aaa")
shinyUI(fluidPage(
# Copy the line below to make a select box
selectInput("select", label = h3("Select Human Gene Sequence"),
choices = list("CD83" = "UGGGUGAUUACAUAAUCUGACAAAUAAAAAAAUCCCGACUUUGGGAUGAGUGCUAGGAUGUUGUAAA"
, "SEC23A" = "UUUCACUGU"
, "ANKFY1" = "AAGUUUGACUAUAUGUGUAAAGGGACUAAAUAUUUUUGCAACAGCC"
,"ENST00000250457"="ACUUGUUGAAUAAACUCAGUCUCC"
),
selected = "UGGGUGAUUACAUAAUCUGACAAAUAAAAAAAUCCCGACUUUGGGAUGAGUGCUAGGAUGUUGUAAA"),
hr(),
fluidRow(column(5, verbatimTextOutput("value")),column(5, verbatimTextOutput("value2")))
))
Server.R
library(shiny)
setwd("C:/Users/ishaan/Documents/aaa")
shinyServer(function(input , output) {
strings=input$select
# You can access the value of the widget with input$select, e.g.
output$value <- renderPrint({ input$select })
output$value2 <- renderPrint({ grep("*gc*",input$value })
})
As already indicated in the comments there are parenteses are missing in your code. Furthermore the statement seems to be wrong. Grep expects a regular expression. The star doesn't make any sense here. Instead you have to use .*. However, this means grep will match the entire string if it contains gc which is I guess also not the result you want to have.
However you can use grepexpr to search for the string gc
>gregexpr("gc","aagccaagcca")[[1]]
[1] 3 8
attr(,"match.length")
[1] 2 2
attr(,"useBytes")
[1] TRUE
The output looks a bit confusing (to me). However you can you can see that the string was found at position 3 and 8
The number of occurences are then given by
length(gregexpr("gc","aagccaagcca")[[1]])
[1] 2
To make it match uppercase strings as well
length(gregexpr("gc","GCaagccaagcca",ignore.case=TRUE)[[1]])
Finally there is an issue with the length calculation if there is no match.
To solve this issue you need to use
mtch <- gregexpr("gcxx","GCaagccaagcxca",ignore.case=TRUE)[[1]]
if(mtch[1]==-1) 0 else length(mtch)

Pattern matching in dataset

been struggling with this for a while.
I have a dataset with two columns, a Description column and the other is the pattern column that I am trying to match against the description column.If the corresponding pattern exists in the Description column, it needs to be replaced by an asterisk
For instance, if the Description is ABCDEisthedescription and the Pattern is ABCDE, then the new description should *isthedescription
I tried the following
data$NewDescription <- gsub(data$pattern,"\\*",Data$Description )
since there is more than one row in the dataset, it throws an error ( a warning rather)
"argument 'pattern' has length > 1 and only the first element will be used"
Any help will be hugely appreciated.
You can use an mapply here to apply the function to each row.
#sample data
data<-data.frame(
pattern=c("ABCDE","XYZ"),
Description=c("ABCDEisthedescription", "sillyXYZvalue")
)
Now use mapply
mapply(function(p,d) gsub(p, "\\*", d, fixed=T), data$pattern, data$Description)
# [1] "\\*isthedescription" "silly\\*value"
Additionally,
Patterns <- paste0(
sample(LETTERS[1:4],500,replace=TRUE),
sample(LETTERS[1:4],500,replace=TRUE),
sample(LETTERS[1:4],500,replace=TRUE),
sample(LETTERS[1:4],500,replace=TRUE))
##
Desc <- paste0(Patterns,"isthedescription")
Ptrn <- sample(Patterns,500)
##
Data <- data.frame(
Description=Desc,
Pattern=Ptrn,
stringsAsFactors=FALSE)
##
newDesc <- sapply(1:nrow(Data), function(X){
if(substr(Data$Description[X],1,4)==Data$Pattern[X]){
gsub(Data$Pattern[X],"*",Data$Description[X])
} else {
Data$Description[X]
}
})
#MrFlick's approach seems more concise though.