Need plotly colorbar at the bottom - r

Here's a dataframe, and the rendered plot using plotly,
I went through the attributes mentioned on plotly R reference guide but couldn't help myself.
require(plotly)
require(dplyr)
df <- structure(list(nn = c(5, 10, 20), Sparsity = c(93.7, 94.3, 94.9
), Method = c("adjcos", "adjcos", "adjcos"), Filtering = c("IBCF",
"IBCF", "IBCF"), error = c("MAE", "MAE", "MAE"), `5` = c(0.716433082,
0.746625993, 0.786221009), `10` = c(0.709316631, 0.737244112,
0.784197414), `20` = c(0.711888414, 0.73875951, 0.783307894),
`30` = c(0.716054462, 0.741430884, 0.78574634), `50` = c(0.722296008,
0.745516396, 0.788986052), `70` = c(0.727236608, 0.749367689,
0.792077439), `100` = c(0.73261171, 0.75337796, 0.795475065
), `150` = c(0.738988515, 0.75764295, 0.799090637), `200` = c(0.743606268,
0.760689524, 0.801416126)), row.names = c(NA, -3L), class = c("tbl_df",
"tbl", "data.frame"))
plot_ly(x = ~df$Sparsity, y = ~df$nn, z = ~as.matrix(df[,-c(1:5)])) %>%
add_surface()
Plot I obtained
I need the colorbar/scale (referenced here colorbar attributes) at the bottom of the plot, directly rendered from the plot_ly().
as shown below :

Related

How do I insert more expansive dataframe columns with text or a table or ggplot2 ouput into a popup in R / Leaflet?

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"
)

how to put a plot and a table together using grid.arrange

I have a plot and a table, and I would like to combine them into a plot. how should I do that.
Here is my codes:
df<-structure(list(AEDECOD = c("Hypoxia", "Malignant pleural effusion",
"Decubitus ulcer", "Nausea"), ADY = c(13, 13, 13, 14)), row.names = c(NA,
-4L), class = "data.frame")
tbl <-structure(list(`Analysis Relative Day` = 13, `AE Type` = "SER",
`Adverse Event` = "Hypoxia/Malignant pleural effusion"), row.names = c(NA,
-1L), class = c("tbl_df", "tbl", "data.frame"))
p1<- ggplot(data =df, aes(x = ADY, y = AEDECOD))+ geom_point()
p2 <-grid.arrange(p1, tbl,
nrow = 2,as.table = TRUE)
print(p2)
I got the error codes:
Error: Input must be a vector, not a <viewport> object.
If you know any other way to do the same thing, I would like to learn that as well.

We may use ggarrange after converting the tibble to ggtexttable
library(ggpubr)
ggarrange(p1, ggtexttable(tbl), nrow = 2)
Or using the OP's code
library(gridExtra)
grid.arrange(p1, ggtexttable(tbl),
nrow = 2,as.table = TRUE)
-output

Remove specific markers from legend

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)

Using literal month names with year in ramcharts

Here is my code to generate barplot using rAmChart,
library(rAmCharts)
amBarplot(x = "month", y = "value", data = dataset,
dataDateFormat = "MM/YYYY", minPeriod = "MM",
show_values = FALSE, labelRotation = -90, depth = 0.1)
However, is there a way to use month names & year in my x axis? I am trying to use MMM-YY formats.
Sample dataset,
structure(list(value = c(11544, 9588, 9411, 10365, 11154, 12688
), month = c("05/2012", "06/2012", "07/2012", "08/2012", "09/2012",
"10/2012")), .Names = c("value", "month"), row.names = c(NA,
6L), class = "data.frame")
Thanks.

It appears that rAmCharts doesn't expose AmCharts' dateFormats setting in the categoryAxis, so you have to access it through the init event and create your own dateFormats array with a modified format string for the MM period. I'm not very experienced with R, but here's how I managed to make it work using R 3.4.2 and rAmCharts 2.1.5
chart <- amBarplot( ... settings omitted ... )
addListener(.Object = chart,
name = 'init',
expression = paste(
"function(e) {",
"e.chart.categoryAxis.dateFormats = ",
'[{"period":"fff","format":"JJ:NN:SS"},{"period":"ss","format":"JJ:NN:SS"},',
'{"period":"mm","format":"JJ:NN"},{"period":"hh","format":"JJ:NN"},{"period":"DD","format":"MMM DD"},',
'{"period":"WW","format":"MMM DD"},',
'{"period":"MM","format":"MMM-YY"},', # "add YY to default MM format
'{"period":"YYYY","format":"YYYY"}]; ',
'e.chart.validateData();',
"}")
)

Here is a different solution:
library(rAmCharts)
dataset <- structure(list(value = c(11544, 9588, 9411, 10365, 11154, 12688
), month = c("05/2012", "06/2012", "07/2012", "08/2012", "09/2012",
"10/2012")), .Names = c("value", "month"), row.names = c(NA,
6L), class = "data.frame")
dataset$month <- as.character(
format(
as.Date(paste0("01/",dataset$month), "%d/%m/%Y"),
"%B %Y"))
amBarplot(x = "month", y = "value", data = dataset,
show_values = FALSE, labelRotation = -90, depth = 0.1)

Chaning labels in choropleth hcmap

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}"))

Resources