I am referring to the choropleth tutorial for Leaflet (https://rstudio.github.io/leaflet/choropleths.html) and modifying it for Shiny. I have different columns that I want to be able to use depending on what the user selects. The problem I encounter has to do with this part:
pal <- colorBin("YlOrRd", domain = states$density, bins = bins)
m %>% addPolygons(
fillColor = ~pal(density),
weight = 2,
opacity = 1,
color = "white",
dashArray = "3",
fillOpacity = 0.7)
Specifically, I want to be able to replace the density column be a column that I can get from a button in Shiny (assume the columns are called a and b and that I get them from the name_button object). I create the col_name function to enclose this choice:
col_name <- reactive({
name <- switch(input$name_button, "A" = "a", "B" = "b" )
name})
Then I can modify the pal <- ... line as follows (see R how use a string variable to select a data frame column using $ notation):
pal <- colorBin("YlOrRd", domain = states[[col_name()]], bins = bins)
However, I am not sure how to change the fillColor = ~pal(density), line because density is the name of a column. I have tried
fillColor = ~pal([[col_name]])
but this doesn't work. What can I do?
Also, what is the function of the tilde ~ in ~pal(...)?
Related
Given the following example data
mydata <- data.frame(
lat = c(21.05939, 21.04305, 21.05977, 21.04336, 21.04434),
lng = c(92.22692 ,92.23357 ,92.22733 ,92.23361 ,92.23478),
X1 = c("sometimes", "always", "never", "often", "rarely")
)
And the following Leaflet plot:
pal1 <- c("#003366","#00ced1", "#ffd700","#ffa500","#ff1a1a")
color <- colorFactor(pal1, domain = mydata$X1)
leaflet(data = mydata) %>%
addTiles() %>%
addCircleMarkers(lng = mydata$lng,
lat = mydata$lat,
color = ~color(mydata$X1)) %>%
addLegend("topright",
pal=color,
values=mydata$X1,
opacity = 1)
How can I manipulate the order of labels in the legend so that they are:
always,
often,
sometimes,
rarely,
never
I have attempted to specify the levels argument in colorFactor() and have also attempted the same with the values argument in addLegend However, the legend still resorts to alphabetical order of the items.
NVM I think I figured it out.
I first specified a sort order by:
sort_val = factor(mydata$X1, levels = c('always',
'often',
'sometimes',
'rarely',
'never'))
I then passed sort_val to the values argument in addlegend()
addLegend("topright",
pal=color,
values=sort_val,
opacity = 1)
I think this is correct unless anyone can suggest an alternative?
Anyone created a leaflet map in Code Workbook using r-Leaflet? I have a functioning script that runs (also double checked in R) but how do I get it to visualise and then use in a Report etc. I have tried various tweaks on what may get it to run but no success - any ideas
leaflet_map <- function(map_data) {
library(leaflet)
data<-map_data
# first cut the continuous variable into bins
# these bins are now factors
data$Fill_rateLvl <- cut(data$Fill_rate,
c(0,.5,0.6,0.7,0.8,0.9,1), include.lowest = T,
labels = c('<50%', '50-60%', '60-70%', '70-80%', '80-90%','90-100%'))
# then assign a palette to this using colorFactor
# in this case it goes from red for the smaller values to yellow and green
# standard stoplight for bad, good, and best
FillCol <- colorFactor(palette = 'RdYlGn', data$Fill_rateLvl)
m<-leaflet() %>%
addTiles() %>%
addProviderTiles(providers$CartoDB.Positron)%>%
setView(lng = -0, lat = 50, zoom = 8) %>%
addCircleMarkers(data = data, lat = ~lat, lng = ~long,
color = ~FillCol(Fill_rateLvl), popup = data$Lead_employer,
radius = ~sqrt(Fill_rate*50), group = 'Fill rate') %>%
addLegend('bottomright', pal = FillCol, values = data$Fill_rateLvl,
title = 'Fill rate for next two weeks',
opacity = 1)
return(NULL)
}
I am not familiar with R in code workbook, but it sounds to me that you need to materialize your leaflet map as a dataset and then consume it in some sort of map compatible UI.
For example slate has a map widget which is backed by leaflets. You can find documentation and examples for it in https://www.palantir.com/docs/foundry/slate/widgets-map/
I am trying the create a plotly gauge graph for a flexdashboard which should change value depending on the chosen filter in crosstalk::filter_select().
I have tried and tried but cannot get the filter to work. This is an example with mtcars of what I am trying to do. I noticed that if the SharedData object has only one value, then it works, but otherwise plotly does not show any data.
mtcars_data <- tibble::rownames_to_column(mtcars, "Car")
shared_mtcars <- SharedData$new(mtcars_data)
row1 <- bscols(filter_select("Car", "Car", shared_mtcars, ~Car, multiple = F)
)
fig <- plot_ly(shared_mtcars,
domain = list(x = c(0, 1), y = c(0, 1)),
value = ~mpg,
title = list(text = "MPG"),
type = "indicator",
mode = "gauge+number")
bscols(row1, fig, widths = 12)
This code results in a graph with no data. If I subset mtcars_data to take the first row or the first two rows (which happen to have the same value for mpg) then it works. If I subset rows 1 and 3, it doesn't.
I might be missing something - in that case would really appreciate any feedback.
I have been trying for some time to debug my Shiny gadget but still cannot manage it. Really appreciate any help.
My gadget consists of a scatterplot generated with Plotly. The user can click one of the points, which will allow you to change some parameters associated with that point. To emphasise the fact that the user has selected that point, I wanted to highlight the selected point.
Alternatively, the user can also select a point from a dropdown menu, which also should highlight the corresponding point.
As an added feature, I want to additionally highlight points that are below a certain threshold on the x axis. This threshold is represented by a dotted line, which you can turn on and off, and move the value of the threshold.
In summary, the points on the plot should all be blue circles, except for the following two cases:
if it is clicked, i.e. it is the "active point" (this should create a red border around the point)
if it is below the threshold on the x-axis (the point should turn to an orange square)
If it is active AND below the threshold, it should be an orange square with a red border, as you would expect.
My gadget works, kind of. But in some cases not. In the example below, one of the points is already below the threshold, but when I select that point, the red marker appears on another point! Despite the active variable being the correct one.
I also get a weird behaviour that the points turn purple if the threshold is below all of the points. But if I move the threshold to be above one of the points, the colours are corrected.
I have a suspicion that this is something to do with the points being on different traces? Therefore when I try to highlight certain points, perhaps I am not indexing the vector as I am expecting. But I am finding it really difficult to debug inside Shiny and Plotly, and I have no good understanding of the Plotly object, so I don't have much clue as to what is going on.
The code below is a reproducible example. You have to run "dat1" through the "rew8r" function. I have taken out other features of the app to try to focus on the problem. Thanks very much to anyone who might take the time to have a look at this, and give any hints!
library(plotly)
library(dplyr)
library(shiny)
library(reactable)
dat1 <- data.frame(
Indicator = c("v1","v2","v3"),
Weight = rep(1,3),
Correlation = c(0.1, 0.8, 0.6) )
rew8r <- function(dat){
# get indicator names
inames <- dat$Indicator
## Create the shiny UI layout
ui <- fluidPage(
# the side panel
sidebarPanel(
selectInput("vseldrop", "Select indicator here or by clicking a point on plot.",
c("<Select>",inames)),
hr(style = "border-top: 1px solid #000000;"),
fluidRow(
column(6,numericInput("locorval", "Low correlation threshold:", 0.2, min = -1, max = 1, step = 0.05)),
column(6,br(),checkboxInput("locorsw", "Enable", value = FALSE)))
),
# the main panel (graph, table, etc)
mainPanel(
plotlyOutput("corrplot"),
textOutput("info")
)
)
## Create the Shiny Server layout
server <- function(input, output, session) {
# this is the plotly click data
event.data <- reactive({event_data(event = "plotly_click", source = "scplot")})
# First, monitor which variable is active
# Create reactive value for active var
acvar <- reactiveVal(NULL)
# update active variable via plot click
observeEvent(event.data(),{
acvar(event.data()$key)})
# update active variable via dropdown
observeEvent(input$vseldrop,
acvar(input$vseldrop))
## Create the plotly plot that compares price vs scoops
output$corrplot <- renderPlotly({
# colours around markers when selected or not
lincol <- ifelse(inames %in% acvar(), "red", "blue")
# size of line around marker (set to 0 if not selected)
linsize <- ifelse(inames %in% acvar(), 3, 0)
# symbol when above/below corr threshold
symbs <- if(input$locorsw==TRUE){c(16,15)}else{c(16,16)}
# colour when above/below threshold
pcols <- if(input$locorsw==TRUE){c("blue", "orange")}else{c("blue", "blue")}
# generate main plot
p <- plot_ly(dat, x = ~Correlation, y = ~Weight, type = "scatter", mode = "markers",
text = ~Indicator, key = ~Indicator, source = "scplot",
marker = list(size = 10, line = list(color = lincol, width = linsize)),
symbol = ~Correlation < input$locorval, symbols = symbs,
color = ~Correlation < input$locorval, colors = pcols) %>%
layout(showlegend = FALSE, yaxis = list(
range = c(0, 1.25),
autotick = FALSE,
dtick = 0.25),
xaxis = list(
range = c(-0.5, 1),
autotick = FALSE,
dtick = 0.2))
# add low correlation line, if activated
if(input$locorsw==TRUE){
p <- p %>% add_segments(x = input$locorval, xend = input$locorval, y = 0, yend = 1.25,
marker = list(color = 'red', opacity=0),
line = list(dash = 'dash')) %>%
layout(showlegend = FALSE)
}
p
})
# Text info
output$info <- renderText({
paste(acvar(), class(acvar()))
})
# update dropdown menu
observeEvent(acvar(),{
updateSelectInput(session, "vseldrop", selected = acvar())
})
}
runGadget(ui, server, viewer = browserViewer())
}
I wanted to have my conditions labelled on the heatmap I am making for DGE.
This code:
mat <- assay(rld)[topVarGenes,]
condition = c("black", "orange")
names(condition) = c("Dark", "Light")
ann_colors = list(condition = condition)
pheatmap(mat, color = colorRampPalette(rev(brewer.pal(n = 7, name = "RdYlBu")))(24), annotation_colors = ann_colors[1], border_color = "grey60", fontsize = 12, scale = "row")
produces this heatmap:
But, this heatmap doesn't have the conditions labelled above the columns like I wanted. So I tried this code:
annotation <- data.frame(annotation)
pheatmap(mat, annotation = annotation, color = colorRampPalette(rev(brewer.pal(n = 7, name = "RdYlBu")))(24), border_color = "grey60", fontsize = 12, scale = "row")
Which almost works, but doesn't use the colors I want to label the conditions (samples 1-3 are "dark" condition and are to be labelled black and samples 4-6 are "light" condition and are to be labelled orange). This graph also includes a funky column label under condition for sample which is redundant and I don't know how to get rid of it. Also, the data.frame(annotation) is an excel sheet I imported of samples and corresponding conditions.
Adding back the annotation_colors to the code:
pheatmap(mat, annotation = annotation, color = colorRampPalette(rev(brewer.pal(n = 7, name = "RdYlBu")))(24), annotation_colors = ann_colors, border_color = "grey60", fontsize = 12, scale = "row")
produces this error:
Error in convert_annotations(annotation_col, annotation_colors) :
Factor levels on variable condition do not match with annotation_colors
Lastly, I tried this bit of code I found in a stack overflow post to define annotation, which gets R to use the correct colors, but they are not in the correct order for the conditions because the %% 2==0 causes it to label every other sample as 'light', but I can't think of anything else to do. Here is the code:
annotation <- data.frame(condition = factor(1:6 %% 2==0, labels = c("Dark", "Light")))
Help is greatly appreciated!
It's not so clear in the vignette, but you can follow the steps below to generate the right data.frame and list, no reason not to work:
First I make a matrix like yours:
library(pheatmap)
M = cbind(matrix(runif(30,min=0,max=0.5),ncol=3),
matrix(runif(30,min=0.3,max=0.8),ncol=3))
rownames(M) = paste0("row",1:10)
colnames(M) = paste0("sample",1:6)
Let's say first 3 columns are "light", and last 3 columns are "dark". We create a data.frame for this, important thing is to have rownames that match the colnames of your matrix:
ann_column = data.frame(
condition = rep(c("light","dark"),each=3))
rownames(ann_col) = colnames(M)
ann_column
condition
1 light
2 light
3 light
4 dark
5 dark
6 dark
Now for the colors, you need a list, and the names need to match the data frame above, and inside the light, you specify what factor matches what color, so:
ann_colors = list(condition = c(dark="black",light="orange"))
And we draw it:
pheatmap(M,annotation_col=ann_col,annotation_colors=ann_colors)