I'm building an shiny application to show some quality control data to our clients. First i had the application created with GGplot functionalities. Now i am converting all graphs to Plotly output. For one of these plots (a boxplot). I have the problem that i cant pass a shiny input selector to the plot.
In GGplot there is no problem at all and the plot is changed each time i choose a different plotColumn. Here i solved the problem of column parsing with the aes_string function. Basically i am looking for something similar in plotly.
Working GGPLOT example:
ggplot(finalDf, aes_string("runName",input$getBoxplotField),na.rm = T) +
geom_boxplot(aes_string(fill="runName"), notch = F) +
geom_jitter() +
scale_y_continuous(labels = format1) +
theme_bw()
Not working Plot_ly example
p <- plot_ly(finalDf,x = runName, y = input$getBoxplotField, type = "box")
exampleDf
> dput(head(finalDf))
structure(list(runName = c("Gentrap.1451849446759", "Gentrap.1451849446759",
"Gentrap.1451849446759", "Gentrap.1451849446759", "Gentrap.1451849446759",
"Gentrap.1451849446759"), sampleName = c("Hart_FC42b_L5_I2_SRD329",
"S1", "S2", "S3","S4", "S5"), readGroupName = c(NA,
NA, NA, NA, NA, NA), maxInsertSize = c(227615351L, 202850798L,
249001722L, 234388122L, 188295691L, 249009605L), medianCvCoverage = c(0.501303,
0.494183, 0.574364, 0.487233, 0.495491, 0.483041), medianInsertSize = c(197L,
203L, 200L, 208L, 200L, 194L), median3PrimeBias = c(0.283437,
0.263973, 0.372476, 0.266946, 0.296308, 0.292954), median5PrimeBias = c(0.139005,
0.21233, 0.123449, 0.185168, 0.169128, 0.152902), median5PrimeTo3PrimeBias = c(0.586081,
0.9234, 0.409042, 0.83276, 0.680496, 0.640518), nBasesAligned = c(1627112497,
1572782400, 1772774189, 1595461211, 1593529487, 1705441762),
nBasesCoding = c(795255442, 778886694, 762223625, 819014623,
759061861, 838846117), nBasesIntergenic = c(140893219, 176728812,
194156767, 120900630, 137267440, 148815172), nBasesIntron = c(134528982,
111795186, 121091943, 96554581, 142587231, 139962698), nBasesRibosomal = c(NA,
NA, NA, NA, NA, NA), nBasesUtr = c(556434854, 505371708,
695301854, 558991377, 554612955, 577817775), nCorrectStrandReads = c(NA_integer_,
NA_integer_, NA_integer_, NA_integer_, NA_integer_, NA_integer_
), nIncorrectStrandReads = c(NA_integer_, NA_integer_, NA_integer_,
NA_integer_, NA_integer_, NA_integer_), nReadsAligned = c(33157934L,
32082625L, 36181227L, 32595741L, 32538544L, 34783342L), nReadsProperPair = c(31935921L,
30983730L, 35015854L, 31358224L, 31405592L, 33479007L), nReadsSingleton = c(3919886L,
4311016L, 4382092L, 3848808L, 3873270L, 4122759L), nReadsTotal = c(37077604L,
36393382L, 40563115L, 36444288L, 36411547L, 38905908L), pctChimeras = c(0.004783,
0.003078, 0.003063, 0.004278, 0.002983, 0.00485), rateIndel = c(0.000071,
0.000076, 0.000081, 0.000066, 0.000072, 0.00007), rateReadsMismatch = c(0.001438,
0.001643, 0.001627, 0.001467, 0.001716, 0.001471), stdevInsertSize = c(120.677992,
129.927513, 114.820226, 138.486257, 118.98163, 115.25774),
group = c("Gentrap.1451849446759", "Gentrap.1451849446759",
"Gentrap.1451849446759", "Gentrap.1451849446759", "Gentrap.1451849446759",
"Gentrap.1451849446759")), .Names = c("runName", "sampleName",
"readGroupName", "maxInsertSize", "medianCvCoverage", "medianInsertSize",
"median3PrimeBias", "median5PrimeBias", "median5PrimeTo3PrimeBias",
"nBasesAligned", "nBasesCoding", "nBasesIntergenic", "nBasesIntron",
"nBasesRibosomal", "nBasesUtr", "nCorrectStrandReads", "nIncorrectStrandReads",
"nReadsAligned", "nReadsProperPair", "nReadsSingleton", "nReadsTotal",
"pctChimeras", "rateIndel", "rateReadsMismatch", "stdevInsertSize",
"group"), row.names = c(NA, 6L), class = "data.frame")
server.R
shinyServer(function(input, output, session) {
output$selectBoxplotField <- renderUI({
selectInput("getBoxplotField", label = "Select variable to plot", choices = names(getAllSampleStats()))
})
output$boxplot <- renderPlotly({
finalDf #as defined above in the example
p <- plot_ly(finalDf, x = runName, y = input$getBoxplotField , type = "box")
})
}
GUI.R
shinyUI(navbarPage(
theme = "bootstrap_sandstone.css",
"SPIN", fluid = T,
tabPanel("Gentrap",
fluidPage(fluidRow(
sidebarlogin(pipelineName = "gentrap"),
column(10,
tabsetPanel(
tabPanel("Metrics distribution",
fluidRow(
column(2),
column(8, plotlyOutput("boxplot")),
column(2)
),
fluidRow(
column(3, uiOutput("selectBoxplotField")),
column(3, checkboxInput("checkboxplot", label = "Compare to All", value = TRUE))
),
fluidRow(
column(9, helpText("If no plot shows up it means this data is not present in the Sentinel QC database"))
)),
))
)))
))
The problem is fixed by passing the DF plus columns directly to the X and Y axes without first passing the DF name as a argument.
Proper plot will be generated when this is done:
plot_ly(x = finalDf[,'runName'], y = finalDf[,input$getBoxplotField] , type = "box", color = 'red') %>%
layout(xaxis = list(showticklabels = FALSE, title = ''), yaxis = yName)
This is wrong:
plot_ly(finalDf, x = runName, y = input$getBoxplotField , type = "box", color = 'red') %>%
layout(xaxis = list(showticklabels = FALSE, title = ''), yaxis = yName)
Related
I am at the very beginning of learning my first programming language, which is R. I am really keen to learn leaflet stuff and made some good progress over the last couple of nights.
Getting stuck with populating more expansive popup content within AddPolylines function. I have got it to populate the Asset_Name from my data frame.
However, how would I approach the following few options:
Using two columns from my data frame together in one popup e.g.
addPolylines(
data = df$Geometry,
color = "red",
weight = 5,
popup = df$Asset_Name & df$Asset_Description,
group = "Polylines"
) %>%
This errors in R, I think because I am using the wrong operator.
How could I use html and call columns from data frame in a popup?
e.g.
"Asset Name:" df$Asset_Name </br>
"Asset Description:" df$Asset_Description
I am trying to read the documentation:
https://rstudio.github.io/leaflet/popups.html
However, I am still lost.
Please help, many thanks for reading.
library(leaflet)
library(sf)
setwd("C:/Users/XXXX/Documents/R Programming Training/Leaflet Learning")
df <- read.csv("CLBWKT_LinesOnly.csv") # ordinary data frame
df <- st_as_sf(df, wkt = "Geometry") # convert to spatial data frame
m <- leaflet(df) %>%
addTiles(group = "OSM (default)") %>%
addProviderTiles(providers$Stamen.Toner, group = "Toner") %>%
addProviderTiles(providers$Stamen.TonerLite, group = "Toner Lite") %>%
addProviderTiles('Esri.WorldImagery', group = "Sat View") %>%
addPolylines(
data = df$Geometry,
color = "red",
weight = 5,
popup = df$Asset_Name,
group = "Polylines"
) %>%
addMiniMap(
minimized = FALSE,
toggleDisplay = TRUE,
position = "bottomleft"
) %>%
addLayersControl(
baseGroups = c("OSM (default)", "Toner", "Toner Lite", "Sat View"),
overlayGroups = c("Polylines", "Markers"),
position = "topleft",
options = layersControlOptions(collapsed = TRUE)
)
m
structure(list(Asset_ID = 100001:100004, System_Name = c("System 1",
"System 1", "System 2", "System 3"), Asset_Description = c("Spoon",
"Fork", "Knife", "Spoon"), Asset_Name = c("Asset Name 1", "Asset Name 2",
"Asset Name 3", "Asset Name 4"), Condition = 1:4, Geometry = structure(list(
structure(c(-1.68639290511313, -1.68635836567153, -1.68565219769999,
-1.68565171774367, 55.1667596590412, 55.1667573239408, 55.1667106840643,
55.1667388899525), dim = c(4L, 2L), class = c("XY", "LINESTRING",
"sfg")), structure(list(structure(c(-1.68034047322624, -1.68038289179782,
-1.68045906926982, -1.68048512895859, -1.68053513999523,
-1.68058793251902, -1.6806304470928, -1.68068494033555, -1.68080486828078,
-1.68090160208891, -1.68098744619037, -1.681059243053, -1.68120417228514,
-1.68130363603522, -1.68144793922962, -1.68149890595872,
-1.68158988492711, -1.6816730354649, -1.68176169843031, -1.68178287840857,
-1.68180681439964, -1.68184330248185, -1.68200852094169,
-1.68211520890884, -1.68229203857493, -1.68246049811455,
-1.68265612784607, -1.68275449461309, -1.68286754214383,
-1.68296114395775, -1.68301728003276, 55.1690912809677, 55.1691070637455,
55.1691323332199, 55.169140494827, 55.1691515333531, 55.16916064358,
55.1691674400557, 55.1691754997488, 55.1691873362278, 55.1692364993597,
55.1692634651086, 55.1692745764327, 55.1692974575058, 55.1693124957266,
55.1693322244598, 55.1693390426607, 55.169338928231, 55.1693570893883,
55.1693777287495, 55.1693813027131, 55.1693859396785, 55.1693971186269,
55.1695004809808, 55.1695393201381, 55.1696303433464, 55.1697228191642,
55.1698040413541, 55.1698414188748, 55.1698879828757, 55.1699450529148,
55.1699800665141), dim = c(31L, 2L)), structure(c(-1.67991922565183,
-1.67992292824692, -1.67992871281608, -1.67994732968346,
-1.67996521661522, -1.67998904788041, -1.6800139147732, -1.68004425890084,
-1.68007241769249, -1.68010884196028, -1.68012858924333,
-1.6801329331177, 55.168869598948, 55.1688759382411, 55.1688828149423,
55.1688994020405, 55.1689122671015, 55.1689300988942, 55.1689468146592,
55.1689633192048, 55.1689780828675, 55.168996915352, 55.169006643819,
55.1690087472255), dim = c(12L, 2L))), class = c("XY", "MULTILINESTRING",
"sfg")), structure(c(-2.94368279166516, -2.94320298450354,
-2.9432258084364, -2.94327592253373, -2.94337226543638, -2.94347479608075,
-2.94341228732479, -2.9437491617188, -2.9438547187328, -2.9441710582173,
-2.94411183934458, -2.94402313529268, -2.94392094322372,
-2.94390413426354, -2.94396915978398, -2.94408578851656,
-2.94421922790838, -2.94438187987448, -2.94481032409716,
-2.94532148602622, -2.94571861309263, -2.9458163103159, -2.94576694513058,
-2.94533487138086, -2.9450376750598, -2.94432397728998, -2.94397161839561,
-2.94368279166516, 53.6793020108077, 53.678857027523, 53.6787355609611,
53.6786927163903, 53.6786616359016, 53.6786790221214, 53.6781670777615,
53.6781583610737, 53.678539583114, 53.6782975501525, 53.6781615690503,
53.6780773665502, 53.6780751396856, 53.678008564149, 53.6779474085154,
53.6779101041121, 53.6779393741804, 53.6779047395532, 53.6778801367235,
53.6779003636815, 53.6778456833108, 53.677875234542, 53.6779514282698,
53.6782701826325, 53.6784544569505, 53.6789694863035, 53.6791996753384,
53.6793020108077), dim = c(28L, 2L), class = c("XY", "LINESTRING",
"sfg")), structure(c(-2.77026256525726, -2.77032326917765,
-2.77041002789989, -2.77043165522445, -2.77039592888796,
-2.77006080010197, -2.76950415373603, -2.76906915073792,
-2.76780760934842, -2.76748858307524, -2.76743110189235,
53.9067111927087, 53.9069910447305, 53.9070736254268, 53.9072398520057,
53.9073167479499, 53.9076341040454, 53.908007526416, 53.9081504365657,
53.9084934043941, 53.9086858978806, 53.9087804581627), dim = c(11L,
2L), class = c("XY", "LINESTRING", "sfg"))), n_empty = 0L, crs = structure(list(
input = NA_character_, wkt = NA_character_), class = "crs"), class = c("sfc_GEOMETRY",
"sfc"), precision = 0, bbox = structure(c(xmin = -2.9458163103159,
ymin = 53.6778456833108, xmax = -1.67991922565183, ymax = 55.1699800665141
), class = "bbox"), classes = c("LINESTRING", "MULTILINESTRING",
"LINESTRING", "LINESTRING"))), row.names = c(NA, -4L), class = c("sf",
"data.frame"), sf_column = "Geometry", agr = structure(c(Asset_ID = NA_integer_,
System_Name = NA_integer_, Asset_Description = NA_integer_, Asset_Name = NA_integer_,
Condition = NA_integer_), class = "factor", levels = c("constant",
"aggregate", "identity")))
The are several options to add your popups. Personally I would add a column with the labels to your dataframe. In my code below I use sprintf for that but paste0 would also work.
Note: I also made your example more minimal to focus on the popup issue by getting rid of all the unnecessary layers.
library(leaflet)
library(sf)
df <- st_as_sf(df, wkt = "Geometry") # convert to spatial data frame
df$popup <- with(df, sprintf("Asset Name: %s</br>Asset Description: %s", Asset_Name, Asset_Description))
leaflet(df) %>%
addTiles(group = "OSM (default)") %>%
addPolylines(
color = "blue",
weight = 20,
popup = ~popup,
group = "Polylines"
)
Sorry if this question has already been answered but I could not find the solution to what I am after. I have a plot that uses both geom_line and geom_point. The result of this is that in the legend, it adds both a line and a point when they should have one or the other. I want to keep the circles for the data tg1 and tg2 and remove the line and then do the opposite to the data full i.e. keep the line but remove the circle. I have seen that something like this works where you want to remove dots from all of the legend entries but nothing to only do specifics Removing ggplot2's geom_point icons from the legend. Can anyone help? Thanks.
#code for plot
library(ggplot2)
library(tidypaleo)
ggplot(LGRSL, aes(x =mmsl , y = Age))+
coord_flip()+
theme_classic(12)+
geom_point(data=tg1,aes(x=mmslc,y=Year,col="Fort Denison 1"),pch=1,size=2)+
geom_point(data=tg2,aes(x=mmslc,y=Year,col="Fort Denison 2"),pch=1,size=2)+
geom_lineh(data = full, aes(x=Lutregalammslc,y=Year,col="Full budget"))+
scale_colour_manual(values=c("grey15","grey50","black"))
## data
## tg1
structure(list(Year = 1886:1891, SLR = c(6919L, 6935L, 6923L,
6955L, 6956L, 6957L), mmsl = c(-0.158, -0.142, -0.154, -0.122,
-0.121, -0.12), m = c(6.919, 6.935, 6.923, 6.955, 6.956, 6.957
), GIA.correction = c(-0.02814, -0.02793, -0.02772, -0.02751,
-0.0273, -0.02709), SLRc = c(6.89086, 6.90707, 6.89528, 6.92749,
6.9287, 6.92991), mmslc = c(-0.19667, -0.18046, -0.19225, -0.16004,
-0.15883, -0.15762)), row.names = c(NA, 6L), class = "data.frame")
##tg2
structure(list(Year = 1915:1920, SLR = c(7011L, 6929L, 6987L,
6945L, 6959L, 6951L), mmsl = c(-0.066, -0.148, -0.09, -0.132,
-0.118, -0.126), m = c(7.011, 6.929, 6.987, 6.945, 6.959, 6.951
), GIA.correction = c(-0.02205, -0.02184, -0.02163, -0.02142,
-0.02121, -0.021), SLRc = c(6.98895, 6.90716, 6.96537, 6.92358,
6.93779, 6.93), mmslc = c(-0.09858, -0.18037, -0.12216, -0.16395,
-0.14974, -0.15753)), row.names = c(NA, 6L), class = "data.frame")
##full
structure(list(Year = 1900:1905, Lutregala = c(-0.103609677,
-0.118603251, -0.134550791, -0.105553735, -0.103983082, -0.121731984
), Wapengo = c(-0.095213147, -0.096005337, -0.115700625, -0.097696891,
-0.084444784, -0.109161066), Tarra = c(-0.106672829, -0.109537943,
-0.135256365, -0.101357772, -0.089716518, -0.104258351), Lutregalammsl = c(-0.292863465,
-0.307857039, -0.323804579, -0.294807523, -0.29323687, -0.310985772
), Wapengommsl = c(-0.257028279, -0.257820469, -0.277515756,
-0.259512023, -0.246259916, -0.270976198), Tarrammsl = c(-0.30925682,
-0.312121933, -0.337840355, -0.303941762, -0.292300508, -0.306842342
), LgGIAc = c(-0.01921, -0.01904, -0.01887, -0.0187, -0.01853,
-0.01836), WapGIAc = c(-0.02486, -0.02464, -0.02442, -0.0242,
-0.02398, -0.02376), TarGIAc = c(-0.02373, -0.02352, -0.02331,
-0.0231, -0.02289, -0.02268), Lutregalammslc = c(-0.312073465,
-0.326897039, -0.342674579, -0.313507523, -0.31176687, -0.329345772
), Wapmmslc = c(-0.281888279, -0.282460469, -0.301935756, -0.283712023,
-0.270239916, -0.294736198), Tarmmslc = c(-0.33298682, -0.335641933,
-0.361150355, -0.327041762, -0.315190508, -0.329522342)), row.names = c(NA,
6L), class = "data.frame")
##LGRSL
structure(list(depths = c(0.5, 1.5, 2.5, 3.5, 4.5, 5.5), RSL = c(0.047746907,
0.025564293, 0.021733558, 0.007855661, -0.004909879, 0.01747051
), RSLerror = c(0.058158556, 0.057902654, 0.057988654, 0.057957388,
0.057905405, 0.057226072), Age = c(2017.456716, 2013.594255,
2006.92838, 1999.675523, 1994.729181, 1990.518154), Ageerror = c(0.373138707,
0.77640096, 1.430582242, 1.627131115, 3.222393394, 3.239674718
), mmsl = c(0.01993169, -0.002250924, -0.006081659, -0.019959556,
-0.032725096, -0.010344707)), row.names = c(NA, 6L), class = "data.frame")
##LGRSLgp
structure(list(Age = 1892:1897, mean = c(-0.298147401, -0.304630597,
-0.31023294, -0.315506983, -0.321225142, -0.327190675), error = c(0.051858047,
0.04985084, 0.047760525, 0.045624121, 0.043505044, 0.041477551
), min = c(-0.246289354, -0.254779758, -0.262472416, -0.269882862,
-0.277720098, -0.285713124), max = c(-0.350005447, -0.354481437,
-0.357993465, -0.361131103, -0.364730186, -0.368668226), x = c(-0.02125,
-0.02108, -0.02091, -0.02074, -0.02057, -0.0204), meangia = c(-0.276897401,
-0.283550597, -0.28932294, -0.294766983, -0.300655142, -0.306790675
), rate = c(NA, -4.967327, -4.946326, -4.964493, -4.977451, -4.911859
), raterror = c(NA, 3.581013, 3.796417, 4.022157, 4.226762, 4.255126
), mmsl = c(-0.325962618, -0.332445814, -0.338048157, -0.3433222,
-0.349040359, -0.355005892)), row.names = c(NA, 6L), class = "data.frame")
Here is a way.
Override the guide legend with a list of vectors of values for each of the aesthetics involved, shape and linetype. Note the different ways to specify what is to be removed.
I have also simplified the code a bit.
library(ggplot2)
library(dplyr)
colrs <- c("Fort Denison 1" = "grey15",
"Fort Denison 2" = "grey50",
"Full budget" = "black")
legnd <- list(shape = c(1, 1, NA),
linetype = c("blank", "blank", "solid"))
bind_rows(
tg1 %>% mutate(col = "Fort Denison 1"),
tg2 %>% mutate(col = "Fort Denison 2")
) %>%
ggplot(aes(x = mmslc, y = Year, colour = col)) +
geom_point(pch = 1, size = 2) +
geom_lineh(data = full, aes(x = Lutregalammslc, col = "Full budget"))+
scale_colour_manual(values = colrs,
guide = guide_legend(override.aes = legnd)) +
coord_flip() +
theme_classic(base_size = 12)
EDITED to include full UI and sample data
I did read the other StackOverflow qs on this issue, but none seemed to address the cause of my error.
When the app loads, I get "error object [name of district I've selected] not found" for the District (inputID = "d"). I know it must be an issue with the subsetting reactive in the server, but I've tried everything (loading the data in the server, removing the vector from the filter function, changing the data type of the variables).
I also took this code from another Shiny App I built, which works. I can't see any differences between the two, besides that one is geom_point() and this is geom_col() so again, not sure what is going on.
Thanks!
Sample data:
sample <- sample_n(pop, 10)
dput(sample)
structure(list(GazID = c(NA, NA, "13872", NA, "13610", "13985",
"13984", "13434", "13428", "13631"), Province = c("Niolandskaia",
"Kaluzhskaia", "Iaroslavskaia", "Vyborgskaia", "Moskovskaia",
"Volynskaia", "Volynskaia", "Orenburgskaia", "Orenburgskaia",
"Arkhangel'skaia"), District = c(NA, "Suhinichinbezuezdniigorod",
"Romanov", NA, "Zvenigorod", "Kovel", "Lutsk", "Ufa", "Orenburg",
"Mezen"), TotalPop = c(NA, NA, 104104, NA, 71746, 103381, 102779,
93145, 62740, 26796), Male = c(NA, NA, 48604, NA, 36948, 52266,
50393, 46403, 32617, 13078), Female = c(NA, NA, 55500, NA, 34798,
51115, 52386, 46742, 30123, 13718), City = c(NA, 5552, NA, NA,
1253, 4254, 5552, 6682, 9533, NA), Rural = c(NA, NA, NA, NA,
70493, 99127, 97228, 86483, 53207, NA)), row.names = c(NA, -10L
), class = c("tbl_df", "tbl", "data.frame"))
Above the UI:
library(tidyverse)
library(readr)
library(shiny)
library(stringr)
library(rebus)
pop <- read_csv("pop.csv")
pop$TotalPop <- str_replace_all(pop$TotalPop, pattern = fixed(","), replacement = "")
pop$Male <- str_replace_all(pop$Male, pattern = fixed(","), replacement = "")
pop$Female <- str_replace_all(pop$Female, pattern = fixed(","), replacement = "")
pop$City <- str_replace_all(pop$City, pattern = fixed(","), replacement = "")
pop$Rural <- str_replace_all(pop$Rural, pattern = fixed(","), replacement = "")
pop$District <- str_remove_all(pop$District, pattern = "[^[:alnum:]]")
pop$TotalPop <- as.numeric(pop$TotalPop)
pop$Male <- as.numeric(pop$Male)
pop$Female <- as.numeric(pop$Female)
pop$City <- as.numeric(pop$City)
pop$Rural <- as.numeric(pop$Rural)
pop$GazID <- as.character(pop$GazID)
pop$District <- str_trim(pop$District)
The UI:
ui <- fluidPage(
titlePanel("Population Data from VSO"),
sidebarLayout(
sidebarPanel(
selectInput(inputId = "y", #internal label
label = "Population to map", #label that user sees
choices = c("Total population" = "TotalPop",
"Male population" = "Male",
"Female population" = "Female",
"Urban population" = "City",
"Rural population" = "Rural"),
selected = "TotalPop"),
selectizeInput(inputId = "d",
label = "Select district",
choices = c(pop$District),
multiple = TRUE, # can choose multiple
options = list(maxItems = 5))),
mainPanel(
plotOutput("plot")
)
)
)
The server:
server <- function(input, output) {
pop_subset <- reactive({
req(input$d)
filter(pop, District %in% c(input$d)
)})
output$plot <- renderPlot({
ggplot(data = pop_subset(), aes_string(x = pop_subset()$District, y = input$y)) +
geom_col(aes(fill = pop_subset()$District)) +
labs(x = "District", y = "Population") +
scale_fill_discrete(name = "Districts")
})}
shinyApp(ui = ui, server = server)
The problem is that you are using aes_string in your ggplot, but trying to pass District without quotes. I realize you need aes_string because you are using input$y, so just change your plot call to
output$plot <- renderPlot({
req(pop_subset())
ggplot(data = pop_subset(), aes_string(x = "District", y = input$y)) +
geom_col(aes(fill = District)) +
labs(x = "District", y = "Population") +
scale_fill_discrete(name = "Districts")
})
For reproducibility, packages and some sample data (no idea of its true representative nature, doesn't really matter I think).
library(dplyr)
library(shiny)
library(ggplot2)
set.seed(42)
n <- 50
pop <- data_frame(
TotalPop = sample(1e4, size=n, replace=TRUE)
) %>%
mutate(
Male = pmax(0, TotalPop - sample(1e4, size=n, replace=TRUE)),
Female = TotalPop - Male,
City = sample(LETTERS, size=n, replace=TRUE),
District = sample(letters, size=n, replace=TRUE)
)
I'm trying to reorder the x axis by the values in the y axis. The x axis is a name, the y axis is an integer. Both are reactive, user defined inputs. I have created a datatable that renders in the correct order, but ggplot does not take that order. Instead it does an alphabetical order.
My current code is:
Packages
library(shiny)
library(readxl) # to load the data into R
library(tidyverse)
library(stringr)
library(DT)
library(tools)
library(magrittr)
Data
lpop <-read.csv("londonpopchange.csv", header=TRUE)
UI
# Define UI for application that plots features of movies
ui <- fluidPage(
# Sidebar layout with a input and output definitions
sidebarLayout(
# Inputs
sidebarPanel(
# Select variable for y-axis
selectInput(inputId = "y",
label = "Y-axis:",
choices = c("Mid Year 2016" = "MYE2016",
"Births" = "Births",
"Deaths" = "Deaths",
"Births minus Deaths" = "BirthsminusDeaths",
"Internal Migration Inflow" = "InternalMigrationInflow",
"Internal Migration Outflow" = "InternalMigrationOutflow",
"Internal Migration Net" = "InternalMigrationNet",
"International Migration Inflow" = "InternationalMigrationInflow",
"International Migration Outflow" = "InternationalMigrationOutflow",
"International Migration Net" = "InternationalMigrationNet"),
selected = "MYE2016"),
# Select variable for x-axis
selectInput(inputId = "x",
label = "X-axis:",
choices = c("Borough" = "Name"),
selected = "Name")
),
# Output
mainPanel(
h1(textOutput("MainTitle")),
br(),
plotOutput(outputId = "geom_bar"),
DT::dataTableOutput("mytable")
)
)
)
Server
# Define server function required to create the scatterplot
server <- function(input, output) {
#this creates the title
output$MainTitle <- renderText({
paste(input$y, "for London Boroughs")
})
#creates a data table that reacts to the user variable input and arranges
#by the y variable
df <- reactive({
lpop %>%
select(input$x, input$y, "WF") %>%
arrange_(.dots = input$y) #%>%
# setNames(1:2, c("x", "y"))
})
#outputs the user defined data frame
output$mytable = ({DT::renderDataTable({df()})})
# Create the bar plot object the plotOutput function is expecting
output$geom_bar <- renderPlot({
ggplot(data = df(), aes_string(x = input$x, y = input$y, fill = "WF")) +
geom_bar(stat = "identity") +
scale_fill_manual(values=c("#000000", "#00D253")) +
theme(axis.text.x = element_text(angle = 90)) +
xlab(input$x)
})
}
# Create a Shiny app object
shinyApp(ui = ui, server = server)
It renders as so: https://jwest.shinyapps.io/ShinyPopulation/
If I use the reorder function in ggplot, it amalgamates all "Names" into one bar, see below.
# Create the bar plot object the plotOutput function is expecting
output$geom_bar <- renderPlot({
ggplot(data = df(), aes_string(x = reorder(input$x, input$y), y = input$y, fill = "WF")) +
geom_bar(stat = "identity") +
scale_fill_manual(values=c("#000000", "#00D253")) +
theme(axis.text.x = element_text(angle = 90)) +
xlab(input$x)
})
}
How can I render it by the Y axis? Is it something to do with scale_x_discrete(limits = ...). If it is I am confused as to how i'm meant to reference the first column of the reactive df
The csv can be downloaded here: https://drive.google.com/file/d/1QLT8CX9XFSx3WU_tADyWgyddHYd3-VSp/view?usp=sharing
DPUT
structure(list(Code = structure(c(7L, 1L, 12L, 13L, 14L), .Label = c("E09000001",
"E09000002", "E09000003", "E09000004", "E09000005", "E09000006",
"E09000007", "E09000008", "E09000009", "E09000010", "E09000011",
"E09000012", "E09000013", "E09000014", "E09000015", "E09000016",
"E09000017", "E09000018", "E09000019", "E09000020", "E09000021",
"E09000022", "E09000023", "E09000024", "E09000025", "E09000026",
"E09000027", "E09000028", "E09000029", "E09000030", "E09000031",
"E09000032", "E09000033"), class = "factor"), Name = structure(c(6L,
7L, 12L, 13L, 14L), .Label = c("Barking and Dagenham", "Barnet",
"Bexley", "Brent", "Bromley", "Camden", "City of London", "Croydon",
"Ealing", "Enfield", "Greenwich", "Hackney", "Hammersmith and Fulham",
"Haringey", "Harrow", "Havering", "Hillingdon", "Hounslow", "Islington",
"Kensington and Chelsea", "Kingston upon Thames", "Lambeth",
"Lewisham", "Merton", "Newham", "Redbridge", "Richmond upon Thames",
"Southwark", "Sutton", "Tower Hamlets", "Waltham Forest", "Wandsworth",
"Westminster"), class = "factor"), Geography = structure(c(1L,
1L, 1L, 1L, 1L), .Label = "London Borough", class = "factor"),
MYE2016 = c(249162L, 7246L, 273239L, 181783L, 272078L), Births = c(2671L,
68L, 4405L, 2446L, 3913L), Deaths = c(1180L, 38L, 1168L,
895L, 1140L), BirthsminusDeaths = c(1491L, 30L, 3237L, 1551L,
2773L), InternalMigrationInflow = c(22189L, 856L, 21271L,
19109L, 22469L), InternalMigrationOutflow = c(25132L, 792L,
23324L, 20488L, 29113L), InternalMigrationNet = c(-2943L,
64L, -2053L, -1379L, -6644L), InternationalMigrationInflow = c(11815L,
756L, 5054L, 5333L, 7480L), InternationalMigrationOutflow = c(6140L,
441L, 3534L, 4336L, 4460L), InternationalMigrationNet = c(5675L,
315L, 1520L, 997L, 3020L), Other = c(-24L, -1L, -14L, 46L,
-3L), Estimated.Population..mid.2017 = c(253361L, 7654L,
275929L, 182998L, 271224L), WF = structure(c(1L, 1L, 1L,
1L, 1L), .Label = c("London Borough", "Waltham Forest"), class = "factor")), .Names = c("Code",
"Name", "Geography", "MYE2016", "Births", "Deaths", "BirthsminusDeaths",
"InternalMigrationInflow", "InternalMigrationOutflow", "InternalMigrationNet",
"InternationalMigrationInflow", "InternationalMigrationOutflow",
"InternationalMigrationNet", "Other", "Estimated.Population..mid.2017",
"WF"), row.names = c(NA, 5L), class = "data.frame")
I have the following dataset:
structure(list(code = structure(1:6, .Label = c("?elino", "?tip",
"?uto Orizari", "Aerodrom", "Aracinovo", "Berovo", "Bitola",
"Bogdanci", "Bogovinje", "Bosilovo", "Brod", "Brvenica", "Butel",
"Ca?ka", "Cair", "Ce?inovo-Oble?evo", "Centar", "Centar ?upa",
"Cucer Sandevo", "Debar", "Debarca", "Delcevo", "Demir Hisar",
"Demir Kapija", "Dojran", "Dolneni", "Drugovo", "Gazi Baba",
"Gjorce Petrov", "Gostivar", "Gradsko", "Ilinden", "Jegunovce",
"Karbinci", "Karpo?", "Kavadartsi", "Kicevo", "Kisela Voda",
"Kocani", "Konce", "Kratovo", "Kriva Palanka", "Krivoga?tani",
"Kru?evo", "Kumanovo", "Lipkovo", "Lozovo", "Makedonska Kamenica",
"Mavrovo and Rostusa", "Negotino", "Northeastern", "Novatsi",
"Novo Selo", "Ohrid", "Oslomej", "Pelagonia", "Phecevo", "Plasnica",
"Polog", "Prilep", "Probistip", "Radovis", "Rankovce", "Resen",
"Saraj", "Skopje", "Sopiste", "Southeastern", "Struga", "Studenicani",
"Sveti Nikole", "Tearce", "Tetovo", "Valandovo", "Vardar", "Vasilevo",
"Veles", "Vev?ani", "Vinitsa", "Vrane?tica", "Zajas", "Zelenikovo",
"Zrnovci"), class = "factor"), value = c(48L, 1810L, 205L, 1507L,
38L, 66L), OPSTINA_NAZIV = c("ЖЕЛИНО", "ШТИП", "ШУТО ОРИЗАРИ",
"АЕРОДРОМ", "АРАЧИНОВО", "БЕРОВО"), `postal-code` = c("ZE", "ST",
"SO", "AD", "AR", "BR")), .Names = c("code", "value", "OPSTINA_NAZIV",
"postal-code"), row.names = c(NA, 6L), class = "data.frame")
and I'm plotting a choropleth map with the hcmap function below:
hcmap("countries/mk/mk-all.js", data = data_fake,
name = "Manucipalities", value = "value", joinBy = c("name", "code"),
borderColor = "transparent") %>%
hc_colorAxis(dataClasses = color_classes(c(seq(0, 2000, by = 500), 13000))) %>%
hc_legend(layout = "vertical", align = "right",
floating = TRUE, valueDecimals = 0, valueSuffix = "") %>%
hc_mapNavigation(enabled = TRUE)
However, at the moment the labels that appear on the map are from the "code" variable, which contain encoding problems. I want to plot the labels from the "OPSTINA_NAZIV" label.
Any ideas how I can do this?
I tried:
dataLabels = list(enabled = TRUE, format = '{point.OPSTINA_NAZIV}')
But it didn't work out.
You can access to the mapData info using the options accesor. Example {point.options.OPSTINA_NAZIV}:
hcmap("countries/mk/mk-all.js", data = data_fake,
name = "Manucipalities", value = "value", joinBy = c("name", "code"),
borderColor = "transparent" ,
dataLabels = list(enabled = TRUE, format = "{point.options.OPSTINA_NAZIV}"))