I am creating a scatterplot using ggplot. I am able to create a scatterplot using the following code.
ggplot(df2, aes(x = date, y = mean, color = NULL)) +
geom_point(position = "jitter") +
labs(title = "ShotSpotter incidents around July 4th",
x = "Day of year", y = "Mean daily gunshots") +
labs(fill = "Treatment Status") +
geom_segment(aes(x = "07-01", xend = "07-01", y = 0, yend = 50), colour = "red")
I would like to change the labels on the x-axis so that they are easier to read. When I try to do so using scale_x_discrete(), most of the datapoints disappear except for those corresponding to the values now labeled on the x-axis.
ggplot(df2, aes(x = date, y = mean, color = NULL)) +
geom_point(position = "jitter") +
labs(title = "ShotSpotter incidents around July 4th",
x = "Day of year", y = "Mean daily gunshots") +
labs(fill = "Treatment Status") +
geom_segment(aes(x = "07-01", xend = "07-01", y = 0, yend = 50), colour = "red") +
scale_x_discrete(limits = c("05-01", "06-01", "07-01", "08-01", "09-01"),
labels = c("May 1", "June 1", "July 1", "Aug 1", "Sept 1"))
How can I keep the labels from the 2nd graph and include all the datapoints shown in the 1st?
Data using dput():
structure(list(date = structure(c(1L, 2L, 3L, 4L, 5L, 6L, 7L,
8L, 9L, 10L, 11L, 12L, 13L, 14L, 15L, 16L, 17L, 18L, 19L, 20L,
21L, 22L, 23L, 24L, 25L, 26L, 27L, 28L, 29L, 30L, 31L, 32L, 33L,
34L, 35L, 36L, 37L, 38L, 39L, 40L, 41L, 42L, 43L, 44L, 45L, 46L,
47L, 48L, 49L, 50L, 51L, 52L, 53L, 54L, 55L, 56L, 57L, 58L, 59L,
60L, 61L, 62L, 63L, 64L, 68L, 69L, 70L, 71L, 72L, 73L, 74L, 75L,
76L, 77L, 78L, 79L, 80L, 81L, 82L, 83L, 84L, 85L, 86L, 87L, 88L,
89L, 90L, 91L, 92L, 93L, 94L, 95L, 96L, 97L, 98L, 99L, 100L,
101L, 102L, 103L, 104L, 105L, 106L, 107L, 108L, 109L, 110L, 111L,
112L, 113L, 114L, 115L, 116L, 117L, 118L, 119L, 120L, 121L, 122L,
123L, 124L), .Label = c("05-01", "05-02", "05-03", "05-04", "05-05",
"05-06", "05-07", "05-08", "05-09", "05-10", "05-11", "05-12",
"05-13", "05-14", "05-15", "05-16", "05-17", "05-18", "05-19",
"05-20", "05-21", "05-22", "05-23", "05-24", "05-25", "05-26",
"05-27", "05-28", "05-29", "05-30", "05-31", "06-01", "06-02",
"06-03", "06-04", "06-05", "06-06", "06-07", "06-08", "06-09",
"06-10", "06-11", "06-12", "06-13", "06-14", "06-15", "06-16",
"06-17", "06-18", "06-19", "06-20", "06-21", "06-22", "06-23",
"06-24", "06-25", "06-26", "06-27", "06-28", "06-29", "06-30",
"07-01", "07-02", "07-03", "07-04", "07-05", "07-06", "07-07",
"07-08", "07-09", "07-10", "07-11", "07-12", "07-13", "07-14",
"07-15", "07-16", "07-17", "07-18", "07-19", "07-20", "07-21",
"07-22", "07-23", "07-24", "07-25", "07-26", "07-27", "07-28",
"07-29", "07-30", "07-31", "08-01", "08-02", "08-03", "08-04",
"08-05", "08-06", "08-07", "08-08", "08-09", "08-10", "08-11",
"08-12", "08-13", "08-14", "08-15", "08-16", "08-17", "08-18",
"08-19", "08-20", "08-21", "08-22", "08-23", "08-24", "08-25",
"08-26", "08-27", "08-28", "08-29", "08-30", "08-31", "09-01"
), class = "factor"), mean = c(13, 15, 16.5, 17.6666666666667,
14.5, 13.3333333333333, 11.8333333333333, 13, 13, 14.3333333333333,
13.8333333333333, 15.5, 11.1666666666667, 15, 12.5, 15.6666666666667,
14.5, 10.5, 11.6666666666667, 17.5, 14.5, 13, 14.6666666666667,
15.6666666666667, 21.3333333333333, 30.6666666666667, 18.5, 17.5,
13.5, 18.5, 13.3333333333333, 14.5, 14.8333333333333, 9.66666666666667,
15.8333333333333, 13.5, 20.5, 16.1666666666667, 15.1666666666667,
14.8333333333333, 15.3333333333333, 14.1666666666667, 14.5, 13.6666666666667,
20.1666666666667, 17.8333333333333, 22.3333333333333, 15.8333333333333,
15.5, 16.1666666666667, 15, 20, 20.8333333333333, 20.8333333333333,
25, 21.1666666666667, 18.1666666666667, 27, 19.5, 19.5, 19.6666666666667,
25.6666666666667, 36.8333333333333, 46.6666666666667, 40.5, 21.3333333333333,
16.3333333333333, 18, 20.1666666666667, 22.6666666666667, 16.8333333333333,
13.8333333333333, 14.5, 14.1666666666667, 16.5, 15.1666666666667,
15.1666666666667, 13.3333333333333, 13.3333333333333, 12.6666666666667,
12.8333333333333, 12.3333333333333, 16.5, 19.6666666666667, 16.3333333333333,
10.6666666666667, 13.1666666666667, 17.5, 10.3333333333333, 15.5,
12.1666666666667, 14.3333333333333, 13.8333333333333, 11.6666666666667,
13, 10.6666666666667, 17.5, 19.3333333333333, 12.6666666666667,
12.5, 12.5, 13.5, 15.8333333333333, 13.5, 15.6666666666667, 16.3333333333333,
14.5, 13.8333333333333, 14.3333333333333, 11, 13.3333333333333,
23.8333333333333, 14.1666666666667, 13.5, 13.3333333333333, 13.3333333333333,
14, 10.6666666666667, 14.3333333333333, 13.3333333333333, 13.1666666666667
)), class = "data.frame", row.names = c(NA, -121L))
df2$date <- as.Date(paste0("2000-", as.character(df2$date)))
ggplot(df2, aes(x = date, y = mean, color = NULL)) +
geom_point(position = "jitter") +
labs(title = "ShotSpotter incidents around July 4th",
x = "Day of year", y = "Mean daily gunshots") +
labs(fill = "Treatment Status") +
geom_segment(aes(x = as.Date("2000-07-01"), xend = as.Date("2000-07-01"), y = 0, yend = 50), colour = "red") +
scale_x_date(labels = scales::date_format("%b-%d"))
This required the two changes: as.Date (I'm supposing 2000 year just for something), and changing geom_segment so that x and xend are Date objects.
We can use
library(dplyr)
library(lubridate)
library(ggplot2)
df2 %>%
mutate(date = mdy(date, truncated = 2)) %>%
ggplot(aes(x = date, y = mean, color = NULL)) +
geom_point(position = "jitter") +
labs(title = "ShotSpotter incidents around July 4th",
x = "Day of year", y = "Mean daily gunshots") +
labs(fill = "Treatment Status") +
geom_segment(aes(x = mdy('07-01', truncated = 2),
xend = mdy('07-01', truncated = 2), y=0, yend = 50), colour = 'red') +
scale_x_date(labels = scales::date_format("%b-%d"))
-output
Related
I try to make a plot with legend for both horizontal lines and vertical lines. Now I would like to test out whether I can add if statement base on the event status.
For the df with both Delay and Sick, my codes works. But if I want to modify the my plotting part so I can use it on a df that might only have Delay or Sick, what should I with my geom_vline and scale_linetype_manualpart? for example, if I want to use my codes on df2.
df<-structure(list(Day = c(0L, 0L, 0L, 1L, 1L, 1L, 8L, 8L, 8L, 15L,
15L, 15L, 22L, 22L, 22L, 27L, 29L, 29L, 29L, 36L, 36L, 36L, 43L,
43L, 43L, 43L, 43L, 43L), Subject = c("ELA", "Math", "Art", "Math",
"Art", "ELA", "ELA", "Math", "Art", "ELA", "Math", "Art", "ELA",
"Math", "Art", NA, "ELA", "Math", "Art", "ELA", "Math", "Art",
"Art", "Art", "Math", "Math", "ELA", "ELA"), Score = c(73L, 157L,
75L, 111L, 82L, 69L, 78L, 131L, 93L, 58L, 109L, 99L, 79L, 131L,
84L, NA, 67L, 106L, 90L, 75L, 123L, 95L, 122L, 122L, 137L, 137L,
83L, 83L), Event = c(NA, NA, NA, "Delay", "Delay", "Delay", NA,
NA, NA, NA, NA, NA, NA, NA, NA, "Sick", NA, NA, NA, NA, NA, NA,
"Sick", "Delay", "Sick", "Delay", "Sick", "Delay")), class = "data.frame", row.names = c(NA,
-28L))
ggplot(data =df)+
geom_line(data=df[!is.na(df$Score),],aes(x = Day, y = Score, color=Subject),size=0.8)+
scale_colour_manual(breaks = c("ELA", "Math", "Art"),
values=c(ELA="#cc0022",Math="#70ad47", Art="#fd9300"))+
geom_vline(data=df[(!is.na(df$Event)&df$Event=="Delay"),], aes(xintercept=jitter(Day), linetype="Delay"), color="black", size=0.4)+
geom_vline(data=df[(!is.na(df$Event)&df$Event=="Sick"),], aes(xintercept=jitter(Day), linetype="Sick"), color="purple", size=0.4)+
scale_linetype_manual(name = 'Event',
values = c('Delay' = 1,
'Sick' = 1),
guide = guide_legend(override.aes = list(colour = c("black",
"purple"))))
df2 <-structure(list(Day = c(0L, 0L, 0L, 1L, 1L, 1L, 8L, 8L, 8L, 15L,
15L, 15L, 22L, 22L, 22L, 27L, 29L, 29L, 29L, 36L, 36L, 36L, 43L,
43L, 43L, 43L, 43L, 43L), Subject = c("ELA", "Math", "Art", "Math",
"Art", "ELA", "ELA", "Math", "Art", "ELA", "Math", "Art", "ELA",
"Math", "Art", NA, "ELA", "Math", "Art", "ELA", "Math", "Art",
"Art", "Art", "Math", "Math", "ELA", "ELA"), Score = c(73L, 157L,
75L, 111L, 82L, 69L, 78L, 131L, 93L, 58L, 109L, 99L, 79L, 131L,
84L, NA, 67L, 106L, 90L, 75L, 123L, 95L, 122L, 122L, 137L, 137L,
83L, 83L), Event = c(NA, NA, NA, "Delay", "Delay", "Delay", NA,
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA,
NA, NA, NA, "Delay", NA, "Delay")), class = "data.frame", row.names = c(NA,
-28L))
I am thinking using sth like this (they don't work)
df<-df2
ggplot(data =df)+
geom_line(data=df[!is.na(df$Score),],aes(x = Day, y = Score, color=Subject),size=0.8)+
scale_colour_manual(breaks = c("ELA", "Math", "Art"),
values=c(ELA="#cc0022",Math="#70ad47", Art="#fd9300"))+
{if (grepl("Delay", df$Event)) geom_vline(data=df[(!is.na(df$Event)&df$Event=="Delay"),], aes(xintercept=jitter(Day), linetype="Delay"), color="black", size=0.4)}+
{if (grepl("Sick", df$Event)) geom_vline(data=df[(!is.na(df$Event)&df$Event=="Sick"),], aes(xintercept=jitter(Day), linetype="Sick"), color="purple", size=0.4)}+
scale_linetype_manual(name = 'Event',
values = c('Delay' = 1,
'Sick' = 1),
guide = guide_legend(override.aes = list(colour = c("black",
"purple"))))
Code chunk 3:
ggplot(data =df)+
geom_line(data=df[!is.na(df$Score),],aes(x = Day, y = Score, color=Subject),size=0.8)+
scale_colour_manual(breaks = c("ELA", "Math", "Art"),
values=c(ELA="#cc0022",Math="#70ad47", Art="#fd9300"))+
geom_vline(data=df[(!is.na(df$Event)&df$Event=="Delay"),], aes(xintercept=jitter(Day),linetype="Delay"), color="black", size=0.4)+
# geom_vline(data=df[(!is.na(df$Event)&df$Event=="Sick"),], aes(xintercept=jitter(Day) ), color="purple", size=0.4)+
scale_linetype_manual(name = 'Event',
values = c(
"Delay" = 1,
"Sick" = 1
),
guide = guide_legend(override.aes = list(colour = c("black",
"purple"))))
With using an if to add the layers you are on the right track. Instead of putting the conditions inside the ggplot code personally I prefer to setup the conditional layers outside of ggplot code and best to put everything inside a function.
Doing so, one option to achieve your desired result may look like so:
EDIT Additionally, instead of using the hack via the linetype aes to get a separate legend you could use the ggnewscale package to add a second color legend. One benefit is that we need no fiddling via override.aes and no additional conditioning to manage the different cases:
library(ggplot2)
plot_fun <- function(df) {
is_delay <- !is.na(df$Event) & df$Event == "Delay"
is_sick <- !is.na(df$Event) & df$Event == "Sick"
layer_delay <- if (any(is_delay)) geom_vline(data = df[is_delay, ], aes(xintercept = jitter(Day), color = "Delay"), size = 0.4)
layer_sick <- if (any(is_sick)) geom_vline(data = df[is_sick, ], aes(xintercept = jitter(Day), color = "Sick"), size = 0.4)
ggplot(data = df) +
geom_line(data = df[!is.na(df$Score), ], aes(x = Day, y = Score, color = Subject), size = 0.8) +
scale_colour_manual(
breaks = c("ELA", "Math", "Art"),
values = c(ELA = "#cc0022", Math = "#70ad47", Art = "#fd9300"),
) +
ggnewscale::new_scale_color() +
layer_delay +
layer_sick +
scale_colour_manual(
name = "Event",
values = c(Delay = "black", Sick = "purple"),
limits = force
)
}
plot_fun(df2)
Sorry if this is a duplicate question but I cannot seem to find the answer to my question anywhere. I have two plots and I would like to overlay plot two on plot one so that they form one plot. Is this possible? I will attach how both plots look separately. They are both facetted by the same variable which is by location and are on the same x and y-axis scale so theoretically should be possible.
Thank you.
## Plot one
Proxy<-read.csv("ALLRSL.csv",header=T)
p1<-ggplot()+
geom_ribbon(data=Proxy,aes(x=YEAR,ymin=LOWER,ymax=UPPER,fill=SITE),alpha=.5)+
geom_line(data=Proxy,aes(x=YEAR,y=RSL,col=SITE))+
facet_wrap(~ SITE,ncol= 1)+
scale_fill_manual(values=c("#4E193D","#342955","#4E617E","#97B4CB"))+
scale_color_manual(values=c("#4E193D","#342955","#4E617E","#97B4CB"))+
theme_classic()+
xlim(1900, 2020)+
theme(panel.grid.major.x = element_blank())+
theme(panel.grid.minor.x = element_blank())+
theme(panel.grid.minor.y = element_blank())+
theme(panel.grid.major.y = element_blank())+
theme(axis.title.x=element_blank(),
axis.text.x=element_blank(),
axis.ticks.x=element_blank())+
theme(
strip.background = element_blank(),
strip.text.x = element_blank()
)+
theme(legend.position="none")
p1
plot two
tgsm<-read.csv("tgsm.csv",header=T)
tgsm<-na.omit(tgsm)
tglonger<-pivot_longer(tgsm, cols=c(-Year),names_to="Site", values_to = "value")
p2<-ggplot()+
geom_point(data=tglonger,aes(x=Year,y=value,col=Site),alpha=.7,size=1)+
facet_wrap(~Site,ncol=1)+
theme_classic()+
xlim(1900,2020)+
scale_color_manual(values=c("#4E193D","#342955","#4E617E","#97B4CB"))+
theme(panel.grid.major.x = element_blank())+
theme(panel.grid.minor.x = element_blank())+
theme(panel.grid.minor.y = element_blank())+
theme(panel.grid.major.y = element_blank())+
theme(axis.title.x=element_blank(),
axis.text.x=element_blank(),
axis.ticks.x=element_blank())+
theme(
strip.background = element_blank(),
strip.text.x = element_blank()
)+
theme(legend.position="none")
p2
Data
Proxy <- structure(list(RSL = c(-0.305251214, -0.306414006, -0.307194187,
-0.308202139, -0.309150572, -0.309679123), UPPER = c(-0.182716456,
-0.186724068, -0.189331305, -0.193118273, -0.197069799, -0.20118809
), LOWER = c(-0.416725663, -0.413606073, -0.411131729, -0.408930899,
-0.406531588, -0.404478981), YEAR = 1820:1825, SITE = structure(c(1L,
1L, 1L, 1L, 1L, 1L), .Label = c("Little Swanport", "Lutregala",
"Tarra", "Wapengo"), class = "factor")), row.names = c(NA, 6L
), class = "data.frame")
tgsm <- structure(list(Year = 1993:1998, Lg2002 = c(-0.001164223, -0.002229453,
-0.002734792, -0.002977787, -0.002786098, -0.002026994), Wap2002 = c(-0.002531348,
-0.002051993, -0.001468704, -0.001182162, -0.001027132, -0.00020881
), Tar2002 = c(-0.029020612, -0.024330561, -0.019927593, -0.015682528,
-0.012907219, -0.009784772), LSP2002 = c(-0.034514531, -0.030171621,
-0.026095138, -0.021952898, -0.018480702, -0.014531318)), na.action = structure(c(`1` = 1L,
`2` = 2L, `3` = 3L, `4` = 4L, `5` = 5L, `6` = 6L, `7` = 7L, `8` = 8L,
`9` = 9L, `10` = 10L, `11` = 11L, `12` = 12L, `13` = 13L, `14` = 14L,
`15` = 15L, `16` = 16L, `17` = 17L, `18` = 18L, `19` = 19L, `20` = 20L,
`21` = 21L, `22` = 22L, `23` = 23L, `24` = 24L, `25` = 25L, `26` = 26L,
`27` = 27L, `28` = 28L, `29` = 29L, `30` = 30L, `31` = 31L, `32` = 32L,
`33` = 33L, `34` = 34L, `35` = 35L, `36` = 36L, `37` = 37L, `38` = 38L,
`39` = 39L, `40` = 40L, `41` = 41L, `42` = 42L, `43` = 43L, `44` = 44L,
`45` = 45L, `46` = 46L, `47` = 47L, `48` = 48L, `49` = 49L, `50` = 50L,
`51` = 51L, `52` = 52L, `53` = 53L, `54` = 54L, `55` = 55L, `56` = 56L,
`57` = 57L, `58` = 58L, `59` = 59L, `60` = 60L, `61` = 61L, `62` = 62L,
`63` = 63L, `64` = 64L, `65` = 65L, `66` = 66L, `67` = 67L, `68` = 68L,
`69` = 69L, `70` = 70L, `71` = 71L, `72` = 72L, `73` = 73L, `74` = 74L,
`75` = 75L, `76` = 76L, `77` = 77L, `78` = 78L, `79` = 79L, `80` = 80L,
`81` = 81L, `82` = 82L, `83` = 83L, `84` = 84L, `85` = 85L, `86` = 86L,
`87` = 87L, `88` = 88L, `89` = 89L, `90` = 90L, `91` = 91L, `92` = 92L,
`93` = 93L, `94` = 94L, `95` = 95L, `96` = 96L, `97` = 97L, `98` = 98L,
`99` = 99L, `100` = 100L, `101` = 101L, `102` = 102L, `103` = 103L,
`104` = 104L, `105` = 105L, `106` = 106L, `107` = 107L, `108` = 108L,
`109` = 109L, `110` = 110L, `111` = 111L, `112` = 112L, `113` = 113L,
`114` = 114L, `115` = 115L, `116` = 116L, `117` = 117L, `118` = 118L,
`119` = 119L, `120` = 120L, `121` = 121L, `122` = 122L, `123` = 123L,
`124` = 124L, `125` = 125L, `126` = 126L, `127` = 127L, `128` = 128L,
`129` = 129L, `130` = 130L, `131` = 131L, `132` = 132L, `133` = 133L,
`134` = 134L, `135` = 135L, `136` = 136L, `137` = 137L, `138` = 138L,
`139` = 139L, `140` = 140L, `141` = 141L, `142` = 142L, `143` = 143L,
`144` = 144L, `145` = 145L, `146` = 146L, `147` = 147L, `148` = 148L,
`149` = 149L, `150` = 150L, `151` = 151L, `152` = 152L, `153` = 153L,
`154` = 154L, `155` = 155L, `156` = 156L, `157` = 157L, `183` = 183L
), class = "omit"), row.names = 158:163, class = "data.frame")
See plot one how you can do that with patchwork.
However. Conceptually, I am guessing you want to add a sort of prediction to some historic values or so. I personally would put everything in one data frame and plot this. If there is a too large gap between the two time points, you can facet by timepoints (as in my suggestion).
The plots look a bit different than your plot because you only provided data for one Site in Proxy (so I filtered the other for what I thought is the equivalent, it will work nonetheless, because the faceting remains) - and I removed all those theme elements that are not relevant to the problem.
Plot one - combining plots.
library(tidyverse)
library(patchwork)
tgsm<-na.omit(tgsm)
tglonger <-
pivot_longer(tgsm, cols=c(-Year), names_to="SITE", values_to = "RSL") %>%
filter(SITE == "LSP2002") %>%
rename(YEAR = Year)
p1 <- ggplot() +
geom_ribbon(data = Proxy, aes(x = YEAR, ymin = LOWER, ymax = UPPER, fill = SITE), alpha = .5) +
geom_line(data = Proxy, aes(x = YEAR, y = RSL, col = SITE)) +
facet_wrap(~SITE) +
coord_cartesian(xlim = c(1800, 1830), ylim = c(-1, 0)) +
theme_classic() +
theme(
axis.title.x = element_blank(),
axis.text.x = element_blank(),
axis.ticks.x = element_blank(),
strip.background = element_blank(),
strip.text.x = element_blank(),
legend.position = "none"
)
p2 <- ggplot() +
geom_point(data = tglonger, aes(x = YEAR, y = RSL, col = SITE), alpha = .7, size = 1) +
facet_wrap(~SITE) +
coord_cartesian(xlim = c(1990, 2000), ylim = c(-1, 0)) +
theme_classic() +
## only one call to theme!!
theme(
## this is where the theme call is different to above
axis.title = element_blank(),
axis.text = element_blank(),
axis.ticks = element_blank(),
axis.line.y = element_blank(),
strip.background = element_blank(),
strip.text.x = element_blank(),
legend.position = "none",
)
p1 + p2
Suggestion for an alternative visualisation
df_new <-
bind_rows(time1 = Proxy, time2 = tglonger, .id = "timevar") %>%
mutate(SITE = "LSP2002")
ggplot(df_new)+
geom_point(aes(x=YEAR,y=RSL))+
facet_grid(SITE~timevar, scales = "free_x")+
theme(legend.position="none") +
theme(panel.spacing = unit(.5, "lines"))
You can also use this data frame in order to create a list of plots, and then stitch it together with patchwork. This approach doesn't allow to change individual plots though.
ls_p <-
df_new %>%
split(., .$timevar) %>%
map(~{ggplot(.x)+
geom_point(aes(x=YEAR,y=RSL))+
coord_cartesian(ylim = c(-0.4,0))+
facet_grid(~SITE, scales = "free_x")+
theme(legend.position="none") +
theme(panel.spacing = unit(.5, "lines"))})
library(patchwork)
wrap_plots(ls_p)
When attempting to render a html app with crosstalk between leaflet/DT, I get the following error:
Error in datatable(sd, extensions = "Scroller", style = "bootstrap", class = "compact", : 'data' must be 2-dimensional (e.g. data frame or matrix)
data frame:
df2 <- data.frame(
structure(list(lat = c(-20.42, -20.62, -26, -17.97, -20.42, -19.68,
-11.7, -28.11, -28.74, -17.47, -21.44, -12.26, -18.54, -21, -20.7,
-15.94, -13.64, -17.83, -23.5, -22.63), long = c(181.62, 181.03,
184.1, 181.66, 181.96, 184.31, 166.1, 181.93, 181.74, 179.59,
180.69, 167, 182.11, 181.66, 169.92, 184.95, 165.96, 181.5, 179.78,
180.31), depth = c(562L, 650L, 42L, 626L, 649L, 195L, 82L, 194L,
211L, 622L, 583L, 249L, 554L, 600L, 139L, 306L, 50L, 590L, 570L,
598L), mag = c(4.8, 4.2, 5.4, 4.1, 4, 4, 4.8, 4.4, 4.7, 4.3,
4.4, 4.6, 4.4, 4.4, 6.1, 4.3, 6, 4.5, 4.4, 4.4), stations = c(41L,
15L, 43L, 19L, 11L, 12L, 43L, 15L, 35L, 19L, 13L, 16L, 19L, 10L,
94L, 11L, 83L, 21L, 13L, 18L)), .Names = c("lat", "long", "depth",
"mag", "stations"), row.names = c(NA, 20L), class = "data.frame")
)
Reproducible code:
library(crosstalk)
library(leaflet) #devtools::install_github('rstudio/leaflet', force = TRUE)
library(DT)
# Wrap data frame in SharedData
sd <- SharedData$new(quakes[sample(nrow(quakes), 10),])
# Create a filter input
filter_slider("mag", "Magnitude", sd, column=~mag, step=0.1, width=250)
# Use SharedData like a dataframe with Crosstalk-enabled widgets
bscols(
leaflet(sd) %>% addTiles() %>% addMarkers(),
datatable(sd, extensions="Scroller", style="bootstrap", class="compact", width="100%",
options=list(deferRender=TRUE, scrollY=300, scroller=FALSE))
)
And the platform and pkg versions:
R version 3.3.2 (2016-10-31)
crosstalk_1.0.1 (#installed from devtools/github)
leaflet_1.0.2.9010
DT_0.2
install 'DT' from devtool/github.
devtools::install_github('rstudio/DT')
I have a dataframe df
df<-structure(list(X = c(540.857881018969, 179.756453922596, 375.597673455575,
-24.7802579900034, 435.072227193852, 316.91305374488, 385.910199259729,
118.282069554042, 47.0931945371692, 46.8541543075746, -1.34917072989697,
-7.85914134272889, -74.1514974421857, -14.1349095526425, -180.103770130757,
-138.258618377921, 189.011576650288, 69.2480232224876, 42.356103377609,
-330.116265944969, 12.2073132306264, 82.0963304851313, -76.2883430762099,
13.7563014075505, 286.364096895997, 238.289414874803, 192.304857815893,
196.85181686938, 545.585335607164, 380.551416666209, 285.533878238757,
349.173312050698, 234.149820388793, 182.680602233473, 123.508718623119,
-59.3666813922188, 309.812271637758, 378.745487723212, 383.286192402579,
407.250999438653, 968.521681377846, 168.221917301957, 308.817578621267,
187.43921153459, 219.229124870899, 273.756349813256, 330.797398870288,
310.938292903419, 285.256002320225, 404.534158133551, 298.161606939762,
96.4609965966811, 237.259654760246, 410.903483047603, 453.107209854966,
476.020674679612, 390.865258755938, -148.590524527974, 109.883635942258,
78.869912902272, 782.478670456904, 245.257050602357, 308.573221705999,
568.136911803784, 163.617826469925, 210.109579924637, 175.657357919781,
175.760684810558, -254.181869342232, 288.452497381572), Y = c(436.783385497984,
55.1825021383702, 526.4133417369, 560, 391.49284084118, -519.814235572849,
11.5525291214872, 162.441016515717, 39.0395567645998, -70.4910326673707,
17.1155716306239, -106.326129257097, -94.9308303585276, -66.4285516217351,
-144.929052323413, -220.613145695315, 157.129576861289, 44.1257786633602,
46.8326830295943, -146.719591499443, 30.8043649939355, -4.10548956954153,
-108.258462657337, 90.3369144331664, 126.866108251153, 42.9489971246803,
690.903947139159, -45.4886732113082, 483.932040393885, 618.930183215125,
590.754048774834, 82.1480000555981, 76.8863707484328, 404.007940533033,
202.629066249886, -46.9675149230141, 557.939170770813, 333.76992898155,
300.979565786038, 224.256197650044, 148.719307398695, 201.195892312115,
466.727302447427, 552.762670615377, 595.145436977735, 481.359543363331,
467.379381521489, 279.980726677847, 545.324660883673, 444.812610935212,
308.198167469197, -638.973101716489, 292, 331.193419647713, 181.896345832773,
629.214319321327, -176.181996958815, 214, 59.1716887350485, -77.1223124726675,
-186.42650026083, 279.123776521767, 515.533437888983, 595.091753601562,
367.15020653978, 713.607404187601, 268.681242669467, 239.81099676255,
91.8453621773515, 246.686055020047), A = c(98.5, 77, 63.2222222222222,
97, 52.5, 3.5, 15.5, 71, 161.833333333333, 153.5, 73, 39, 40,
23, 14, 5.5, 78, 129.5, 73.5, 4, 100, 10, 3, 30, 65.5, 198, 26,
45.5, 20, 42.5, 111.5, 44, 68.5, 102.5, 39.1111111111111, 83.8,
136, 28.6666666666667, 31.5, 56.5, 101, 39.25, 108.5, 52.1666666666667,
54.5, 9.5, 13, 8.5, 8, 52.1428571428571, 66.5, 1, 42, 45, 106,
19, 202.571428571429, 200, 36.6, 83.75, 2, 33, 21.2, 69, 67.5,
14, 83, 16, 4, 99)), .Names = c("X", "Y", "A"), row.names = c(1L,
2L, 3L, 4L, 5L, 6L, 7L, 8L, 9L, 10L, 11L, 12L, 13L, 14L, 15L,
16L, 17L, 18L, 19L, 20L, 21L, 22L, 23L, 24L, 25L, 26L, 27L, 28L,
29L, 30L, 31L, 32L, 33L, 34L, 35L, 36L, 37L, 38L, 39L, 40L, 41L,
42L, 43L, 44L, 45L, 46L, 47L, 48L, 49L, 50L, 51L, 52L, 53L, 54L,
55L, 56L, 57L, 58L, 59L, 60L, 61L, 62L, 63L, 64L, 65L, 66L, 67L,
68L, 69L, 71L), class = "data.frame", na.action = structure(c(70L,
72L, 73L, 74L, 75L, 76L, 77L, 78L, 79L, 80L, 81L, 82L, 83L, 84L,
85L, 86L, 87L, 88L, 89L, 90L), .Names = c("70", "72", "73", "74",
"75", "76", "77", "78", "79", "80", "81", "82", "83", "84", "85",
"86", "87", "88", "89", "90"), class = "omit"))
I am plotting Y against X with ggplot in a simple scatterplot. However I also want to add a color scheme and a legend based on the variable A. The idea is to have four classes (e.g. 0-50, 50-100, 100-150 and 150-200) in the legend.
I only managed to get a gradient legend so far as such:
library(ggplot2)
ggplot(df, aes(x=X, y=Y, colour=A))+
geom_point(shape=3)+
geom_abline(slope=1)+
theme_bw(base_size = 14, base_family = "Helvetica") +
theme(panel.grid = element_line(colour="grey", size=0.5),
axis.text.x = element_text(hjust = 1),
legend.position="bottom",
legend.box="horizontal",
legend.key = element_blank(),
legend.text=element_text(size=12))+
xlab("Predicted")+
ylab("Observed")+
scale_colour_gradient(name= "Stand age", low= "#67a9cf", high ="#ef8a62")+
guides(colour = guide_colourbar(title.position="top", title.hjust = 0.5),
size = guide_legend(title.position="top", title.hjust = 0.5))
In addition, I would like to have the legend box in the lower right corner inside the panel. Anyone knows how to do it?
library(RColorBrewer)
library (ggplot)
vecP <- c(0, 50, 100, 150, 200, 250)
labP <- c("0-50", "50-100", "100-150", "150-200", "200-250")
df$Age <- cut(df$A, breaks=vecP, labels =labP)
colorsP <- brewer.pal(length(labP), "RdBu")
ggplot(df, aes(x=X, y=Y, colour=Age))+
geom_point(shape=1)+
geom_abline(slope=1)+
theme_bw(base_size = 14, base_family = "Helvetica") +
theme(panel.grid = element_line(colour="grey", size=0.5),
axis.text.x = element_text(hjust = 1),
legend.position=c(1, 0),
legend.direction = "vertical",
legend.justification = c(1,0),
legend.key = element_blank())+
xlab("Predicted")+
ylab("Observed")+
scale_fill_manual(name = "Stand age", values = setNames(colorsP, labP),breaks=rev(labP),labels=rev(labP))
library(ggplot2)
plt <- ggplot(df, aes(x=X, y=Y, colour=A))+
geom_point(shape=3)+
geom_abline(slope=1)+
theme_bw(base_size = 14, base_family = "Helvetica") +
theme(panel.grid = element_line(colour="grey", size=0.5),
axis.text.x = element_text(hjust = 1),
legend.position=c(1, 0),
legend.direction = "horizontal",
legend.justification = c(1,0))+
xlab("Predicted")+
ylab("Observed")+
scale_colour_gradient(name= "Stand age", low= "#67a9cf", high ="#ef8a62")+
guides(colour = guide_colourbar(title.position="top", title.hjust = 0.5),
size = guide_legend(title.position="top", title.hjust = 0.5))
Just changed,
legend.position = c(1,0)
legend.direction = "horizontal"
legend.justification = c(1,0)
I have a dataset that I want to plot with ggplot using geom_histogram (data below). I am having issues with trying to get a gradient colour scheme.
structure(list(UserID = c(39120L, 39536L, 39550L, 39627L, 39632L,
39709L, 39971L, 39988L, 39990L, 40062L, 40065L, 40065L, 40066L,
40142L, 40142L, 40143L, 40161L, 40193L, 40364L, 40437L, 40439L,
40440L, 40451L, 40453L, 40665L, 40665L, 40668L, 40751L, 40843L,
40843L, 40843L, 40846L, 40846L, 40847L, 40847L, 40850L, 40850L,
40884L, 40884L, 40884L, 40896L, 40900L, 40902L, 40903L, 40905L,
40963L, 40966L, 40966L, 40967L, 40967L, 40969L, 40971L, 40971L,
40985L, 40985L, 41010L, 41079L, 41080L, 41080L, 41081L, 41093L,
41108L, 41110L, 41111L, 41113L, 41114L, 41133L, 41137L, 41138L,
41140L, 41161L, 41162L, 41182L, 41186L, 41260L), sales = c(0.0119,
0.0032, 0.0091, 0.0098, 0.0086, 0.0101, 0.0107, 0.0111, 0.0085,
0.0178, 0.0069, 0.0055, 0.0133, 0.0112, 0.0084, 0.0141, 0.0159,
0.01, 0.0054, 0.0129, 0.011, 0.0116, 0.0099, 0.0134, 0.0046,
0.004, 0.0076, 0.005, 0.0027, 0.0037, 3e-04, 0.022, 0.012, 0.0082,
0.0108, 0.0092, 0.0101, 0.0016, 0.0082, 0.0035, 0.007, 0.0098,
0.0146, 0.0074, 0.005, 0.0152, 0.0046, 0.0032, 0.0028, 0, 0.0179,
0.0185, 0.0095, 0.0401, 0.0163, 0.0085, 0.0099, 0.0064, 0.0067,
0.0052, 0.0191, 0.0118, 0.0054, 0.0111, 0.0065, 0.0124, 0.0047,
0.0111, 0.0063, 0.0072, 0.0062, 0.0091, 0.0066, 0.0169, 0.0071
), salesfromtarget = c(0.214285714285714, -0.673469387755102,
-0.0714285714285714, 0, -0.122448979591837, 0.0306122448979592,
0.0918367346938777, 0.13265306122449, -0.13265306122449, 0.816326530612245,
-0.295918367346939, -0.438775510204082, 0.357142857142857, 0.142857142857143,
-0.142857142857143, 0.438775510204082, 0.622448979591837, 0.0204081632653062,
-0.448979591836735, 0.316326530612245, 0.122448979591837, 0.183673469387755,
0.010204081632653, 0.36734693877551, -0.530612244897959, -0.591836734693878,
-0.224489795918367, -0.489795918367347, -0.724489795918367, -0.622448979591837,
-0.969387755102041, 1.24489795918367, 0.224489795918367, -0.163265306122449,
0.102040816326531, -0.0612244897959184, 0.0306122448979592, -0.836734693877551,
-0.163265306122449, -0.642857142857143, -0.285714285714286, 0,
0.489795918367347, -0.244897959183673, -0.489795918367347, 0.551020408163265,
-0.530612244897959, -0.673469387755102, -0.714285714285714, -1,
0.826530612244898, 0.887755102040817, -0.0306122448979592, 3.09183673469388,
0.663265306122449, -0.13265306122449, 0.010204081632653, -0.346938775510204,
-0.316326530612245, -0.469387755102041, 0.948979591836735, 0.204081632653061,
-0.448979591836735, 0.13265306122449, -0.336734693877551, 0.26530612244898,
-0.520408163265306, 0.13265306122449, -0.357142857142857, -0.26530612244898,
-0.36734693877551, -0.0714285714285714, -0.326530612244898, 0.724489795918367,
-0.275510204081633)), .Names = c("UserID", "sales", "salesfromtarget"
), row.names = c(1L, 2L, 3L, 4L, 5L, 6L, 7L, 8L, 9L, 10L, 11L,
12L, 13L, 15L, 16L, 18L, 19L, 20L, 21L, 22L, 23L, 24L, 25L, 26L,
28L, 29L, 31L, 32L, 35L, 36L, 37L, 38L, 39L, 41L, 42L, 44L, 45L,
46L, 47L, 48L, 49L, 50L, 51L, 52L, 53L, 54L, 56L, 57L, 58L, 59L,
60L, 61L, 62L, 63L, 64L, 65L, 67L, 69L, 70L, 72L, 77L, 78L, 79L,
80L, 81L, 82L, 83L, 84L, 85L, 86L, 87L, 88L, 89L, 90L, 93L), class = "data.frame")
Using this code I am trying to use scale_fill_brewer to get a gradient scheme (but it doesn't have to be this specific one, it was just an example of something not working). All of the bars are grey and ideally they would not be grey. Best case scenario I wanted to use something along the lines of scale_fill_gradient(low = "green", high = "blue") (again this doesn't work for me). I feel like I'm missing something fundamental with ggplot2.
require(ggplot2)
require(scales)
require(ggthemes)
ggplot(repex, aes(x = salesfromtarget)) +
geom_histogram(binwidth = .1, alpha = 0.5, colour = "white") +
scale_fill_brewer(palette = "Spectral") +
guides(fill = FALSE) +
theme_solarized() +
ggtitle("Standard Distribution of Sales") + xlab("Sales") + ylab("Frequency") +
theme(plot.title = element_text(size = 13, colour = "black", face = "bold", vjust = 1)) +
theme(axis.title.x = element_text(size = 12, colour = "black", vjust = -.005),
axis.title.y = element_text(size = 12, colour = "black", vjust = 0.2),
axis.text.x = element_text(angle = 45, hjust = 1)) +
scale_x_continuous(breaks = seq(-1.5, 1.5, by = .25),
limits = c(-1.5, 1.5), labels = percent)
You need to define the "fill" variable in the aes() section:
ggplot(repex, aes(x=salesfromtarget, fill=..x..))
+geom_histogram(binwidth=.1)
+scale_fill_gradient("Legend",low = "green", high = "blue")
Since the histogram bars are the count of each x-axis value, if you want to use the original x value you should use "..x..". You can fill with the histogram count using "..count..":
ggplot(repex, aes(x=salesfromtarget, fill=..count..))
+geom_histogram(binwidth=.1)
+scale_fill_gradient("Legend",low = "green", high = "blue")