Related
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)
I have this dataset:
structure(list(AgeGroup = c("Old", "Young"), Point.1 = c(0.401899407258065,
0.432845035714286), Point.2 = c(0.435610404, 0.448826385964912
), Point.3 = c(0.466951088, 0.473339649122807), Point.4 = c(0.490997664,
0.505416649122807), Point.5 = c(0.51047508, 0.517228789473684
), Point.6 = c(0.519614064, 0.520077087719298), Point.7 = c(0.524924236,
0.522939438596491), Point.8 = c(0.535448152, 0.523846929824561
), Point.9 = c(0.539298204, 0.529132140350877), Point.10 = c(0.546288992,
0.535221877192982), Point.11 = c(0.552286756, 0.544069684210526
), Point.12 = c(0.548644056, 0.547988701754386), Point.13 = c(0.546028996,
0.556100789473684), Point.14 = c(0.551464336, 0.557342807017544
), Point.15 = c(0.55835804, 0.552995140350877), Point.16 = c(0.560958056,
0.555753035087719), Point.17 = c(0.566631508, 0.553254912280702
), Point.18 = c(0.573644824, 0.557015719298246), Point.19 = c(0.579504268,
0.560797315789474), Point.20 = c(0.583600364, 0.560459526315789
), Point.21 = c(0.591889884, 0.563138245614035), Point.22 = c(0.598549332,
0.578847140350877), Point.23 = c(0.605920632, 0.59655149122807
), Point.24 = c(0.612308084, 0.611475473684211), Point.25 = c(0.618838952,
0.627695631578947), Point.26 = c(0.626865524, 0.640329719298246
), Point.27 = c(0.634642932, 0.642362438596491), Point.28 = c(0.639958892,
0.640706877192982), Point.29 = c(0.642219468, 0.654251789473684
), Point.30 = c(0.651740076, 0.674775824561404), Point.31 = c(0.657197604,
0.679311385964912), Point.32 = c(0.657618572, 0.673946421052632
), Point.33 = c(0.653554616, 0.67093849122807), Point.34 = c(0.648990388,
0.673238403508772), Point.35 = c(0.643885328, 0.669246245614035
), Point.36 = c(0.636234632, 0.670007543859649), Point.37 = c(0.632127604,
0.667657561403509), Point.38 = c(0.631252172, 0.665906228070175
), Point.39 = c(0.637404984, 0.677649561403509), Point.40 = c(0.6451598,
0.679067614035088), Point.41 = c(0.648019716, 0.688604824561403
), Point.42 = c(0.645375244, 0.692729175438596), Point.43 = c(0.647187664,
0.691994543859649), Point.44 = c(0.651923432, 0.681522859649123
), Point.45 = c(0.650062976, 0.674073456140351), Point.46 = c(0.638525956,
0.660092263157895), Point.47 = c(0.627772732, 0.652689456140351
), Point.48 = c(0.615988064, 0.650307087719298), Point.49 = c(0.599147952,
0.651349771929825), Point.50 = c(0.584897698795181, 0.63722649122807
)), class = "data.frame", row.names = c(NA, -2L))
which a subset of the 50 points looks like:
AgeGroup Point.1 Point.2 Point.3 Point.4 Point.5 Point.6 Point.7 Point.8 Point.9 Point.10 Point.11 Point.12 Point.13 Point.14 Point.15 Point.16
1 Old 0.4018994 0.4356104 0.4669511 0.4909977 0.5104751 0.5196141 0.5249242 0.5354482 0.5392982 0.5462890 0.5522868 0.5486441 0.5460290 0.5514643 0.5583580 0.5609581
2 Young 0.4328450 0.4488264 0.4733396 0.5054166 0.5172288 0.5200771 0.5229394 0.5238469 0.5291321 0.5352219 0.5440697 0.5479887 0.5561008 0.5573428 0.5529951 0.5557530
I am having difficulty plotting all columns on one graph, where X is just 1:50 tick marks and Y is the value of each point, color coded by AgeGroup.
I have tried melt, but I dont think thats necessary as it transposes the data and doubles the Point values.
I've tried variations of the following:
ggplot(YaxL, aes(x=1:50,y=YaxL[2:51])) + geom_point()
and
ggplot(YaxL, aes(x = 1:50)) +
geom_line(aes(y = YaxLDF[1,1], colour = "Old")) +
geom_line(aes(y = YaxLDF[2,1], colour = "Young"))
I feel like I'm overthinking this, help appreciated.
Try this approach. You can reshape to long with pivot_longer() and use the separate() function to extract the point position. After that the design of the plot is very practical. I have used the data you shared as YaxL. Always first try to reshape your data and then the plots can be easily built. Here the code:
library(tidyverse)
#Data process and plot
YaxL %>% pivot_longer(-1) %>%
separate(name,c('name','x'),sep='\\.') %>%
mutate(x=as.numeric(x)) %>%
dplyr::select(-name) %>%
ggplot(aes(x=x,y=value,color=AgeGroup,group=AgeGroup))+
geom_point()
Output:
In the table below, how do I remove the line between the Canada row and the World row?
Also, how do I remove the bold from the column headers (ie 1980, 2019, Change)?
This is different than the proposed link in that I wonder if there is a solution that is of the form:
# Define styles
row_emphasis <- formatter("span", style = ~style("font.weight" = "bold", "font.size" = "18px"))
make_non_bold <- formatter("span", style = "font-style:italic; font-weight:normal")
# Apply styles
formattable(can_world_table, list(
area(row = 1) ~ row_emphasis,
# column headers # ~ make_non_bold
))
As for the part about removing the lines between rows, the suggested answer below does not address my issue. This code adds another line between Canada and the header row line:
row_emphasis <- formatter("span", style = ~style("font.weight" = "bold", "font.size" = "18px", "border-top: 1px solid green"))
library(tidyverse)
library(formattable)
target_year = 1980
current_year = 2019
can_target = 20.464
can2019 = 37.786
world_target = 6123
world2019 = 7456
can_change <- (can2019 - can_target) / can_target
world_change <- (world2019 - world_target) / world_target
can_world_table <- tibble(
region = c("Canada", "World"),
ty = c(round(can_target, digits = 0), round(world_target, digits = -2)),
cy = c(can2019, round(world2019, digits = -2)),
change = percent(c(can_change, world_change), 0)
) %>%
set_names(c("", target_year, current_year, "Change"))
can_world_table
can_world_table <- tibble(
region = c("Canada", "World"),
ty = c(can_target, format(round(world_target, digits = -2), big.mark = ",")),
cy = c(can2019, format(round(world2019, digits = -2), big.mark = ",")),
change = percent(c(can_change, world_change), 0)
) %>%
set_names(c(" ", target_year, current_year, "Change"))
row_emphasis <- formatter("span", style = ~style("font.weight" = "bold", "font.size" = "18px"))
formattable(can_world_table, list(
area(row = 1) ~ row_emphasis
))
I am trying to modify certain items from a list based on a criteria (starts with "rr_esp") in the render.data list.
library(tidyr)
library(dplyr)
library(purrr)
per <- 2015:2019
render.data <- list(
emision = structure(
list(
AÑO = c(2017, 2018, 2019),
TRABAJADORESMES_r = c(58147, 57937, 24818),
MASA_r = c(3439195127, 4091347036.2, 2441068565.77),
TRABAJADORESMESsinDOM = c(58147L, 57928L, 24818L),
MESES = c(12, 12, 5)
),
class = c("tbl_df", "tbl", "data.frame"),
row.names = c(NA, -3L)
),
siniestros = structure(
list(
AÑO = c(2017, 2018, 2019),
N = c(388L, 327L, 115L),
GR_66 = c(64, 53, 15),
JU = c(41L, 5L, 0L),
JN = c(20, 19, 6),
PORINC_66s = c(437.22, 293.73, 82.12),
EDADs = c(15142L, 12886L, 4712L),
SALARIOs = c(13707950.67, 15151144.7, 4800075.4)
),
class = c("tbl_df", "tbl", "data.frame"),
row.names = c(NA, -3L)
),
rr_esp1 = structure(
list(
AÑO = c(2017, 2018, 2019),
MESES = c(12, 12, 5),
TRAB_PROM = c(4845.58, 4828.08, 4963.60),
PORINC = c(6.83, 5.54, 5.47),
SALARIO = c(35329.76, 46333.77, 41739.78),
EDAD = c(39.02, 39.40, 40.97)
),
class = c("tbl_df", "tbl", "data.frame"),
row.names = c(NA, -3L)
),
rr_esp7 = structure(
list(
AÑO = c(2017, 2018, 2019),
JUI_LIQ = c(1539624.21, 318726, 0),
JUI_RVA = c(24434809.51, 2292925.89, 0),
JUI_IBNR = c(0, 25284030.0174036, 22434092.26),
JUI_ULT = c(25974433.72, 27895681.90, 22434092.26),
CM_JUICIO = c(1505898.34, 1806002.14, 1557923.07)
),
class = c("tbl_df", "tbl", "data.frame"),
row.names = c(NA, -3L)
)
)
When apply a loop over their elements, they loses their original itemnames
Afterwards, I dont know a better way to iterate a subset of list elements and assign them a new value. I google it but I do not find a critical solution for list instead of data.frames.
render.data <- invisible(lapply(seq_along(render.data), function(i){
if(startsWith(names(render.data)[i], prefix = "rr_esp")){
render.data[[i]] %>%
complete(`AÑO` = per) %>%
gather(
key = "metrica", value = "valor", -`AÑO`
) %>%
mutate(# orden de las metricas
metrica = factor(metrica, levels = unique(metrica))
) %>%
spread(
key = `AÑO`, value = "valor"
)} else{
render.data[[i]]
}
setNames(render.data[[i]], names(render.data)[i])
}))
This seems like a case where a for loop is much clearer than an lapply. The main advantages of lapply are (a) that it pre-allocates a data structure for the result and (b) has simple syntax to apply a simple function. You already have a data structure for the result, and your function is complex. I don't know what your expected output is, but I would try this:
# find elements to modify
rr_elements = which(startsWith(names(render.data), prefix = "rr_esp"))
# modify in for loop
for (i in rr_elements) {
render.data[[i]] = render.data[[i]] %>%
complete(`AÑO` = per) %>%
gather(key = "metrica", value = "valor",-`AÑO`) %>%
mutate(# orden de las metricas
metrica = factor(metrica, levels = unique(metrica))) %>%
spread(key = `AÑO`, value = "valor")
}
If you want to make this code more re-usable, create a function for the operation on one data frame, and then you can use it easily with for or lapply. In general, I'd say that picking the data frames on which to use the function is better done externally than internally. (That is, I don't like how you have an if() statement checking the name inside the function. Do this logic outside the function, and only give the function the data you want it to use.)
foo = function(data) {
data %>%
complete(`AÑO` = per) %>%
gather(key = "metrica", value = "valor",-`AÑO`) %>%
mutate(# orden de las metricas
metrica = factor(metrica, levels = unique(metrica))) %>%
spread(key = `AÑO`, value = "valor")
}
# now the for loop or lapply is simple:
rr_elements = which(startsWith(names(render.data), prefix = "rr_esp"))
# for loop version
for (i in rr_elements) {
render.data[[i]] = foo(render.data[[i]])
}
# lapply version
render.data[rr_elements] = lapply(render.data[rr_elements], foo)
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)