Related
I have a map which summarizes an indicator of the saturation percentage of real estate by neighborhood in Paris (Observed Price of real estate/maximum price set by law). I would like to add hatched on neighborhoods which have less than 5 observations included in my dataset.
I searched, but I couldn't find a way to do it. Any advice in the right direction is welcomed. Thanks.
Here is my code:
library(sp)
library(sf)
library(rgdal)
library(RColorBrewer)
library(raster)
library(classInt)
library(cartography)
#Importation
setwd("path")
shp <- readOGR(dsn="path/to/file",layer="l_qu_paris")
#Breaks
q10 <- classIntervals(map$saturation2, n=7, style="fixed",
fixedBreaks=c(45,69.999999, 79.9999999, 89.9999999, 99.9999999
,109.99999999, 120))
#Colors
my.palette <- colors()[c(73,26,128,10,652,92)]
#Map
##Scale
scale.parameter = 1.1
xshift = 0
yshift = 0
original.bbox = shp#bbox
edges = original.bbox
edges[1, ] <- (edges[1, ] - mean(edges[1, ])) * scale.parameter + mean(edges[1, ]) + xshift
edges[2, ] <- (edges[2, ] - mean(edges[2, ])) * scale.parameter + mean(edges[2, ]) + yshift
#Saturation
idx <- match(shp$l_qu, map$l_qu)
is.na(idx)
concordance <- map[idx, "saturation2"]
shp$saturation2 <- concordance
spplot(shp, "saturation2",col.regions=my.palette,
col = "black", lwd= 1, at = q10$brks,
main=list(label="% de saturation des meublés 1 pièce",cex=1.2,fontfamily="serif"),
xlim = edges[1, ], ylim = edges[2, ])
grid.text("Saturation moyenne (en%)", x=unit(0.95, "npc"), y=unit(0.50, "npc"), rot=90)
Here is my map:
saturation
Here is an example of a map that i would like to have:
saturation example
Here are the polygons in shapefile format: https://www.data.gouv.fr/fr/datasets/quartiers-administratifs/
And here is my dataset:
map <- structure(list(l_qu = c("Amérique", "Archives", "Arsenal", "Arts-et-Métiers",
"Auteuil", "Batignolles", "Bel-Air", "Belleville", "Bercy", "Bonne-Nouvelle",
"Chaillot", "Champs-Elysées", "Charonne", "Chaussée-d'Antin",
"Clignancourt", "Combat", "Croulebarbe", "Ecole-Militaire", "Enfants-Rouges",
"Epinettes", "Europe", "Faubourg-du-Roule", "Faubourg-Montmartre",
"Folie-Méricourt", "Gaillon", "Gare", "Goutte-d'Or", "Grandes-Carrières",
"Grenelle", "Gros-Caillou", "Halles", "Hôpital-Saint-Louis",
"Invalides", "Jardin-des-Plantes", "Javel", "La Chapelle", "Madeleine",
"Mail", "Maison-Blanche", "Monnaie", "Montparnasse", "Muette",
"Necker", "Notre-Dame", "Notre-Dame-des-Champs", "Odéon", "Palais-Royal",
"Parc-de-Montsouris", "Père-Lachaise", "Petit-Montrouge", "Picpus",
"Place-Vendôme", "Plaine de Monceaux", "Plaisance", "Pont-de-Flandre",
"Porte-Dauphine", "Porte-Saint-Denis", "Porte-Saint-Martin",
"Quinze-Vingts", "Rochechouart", "Roquette", "Saint-Ambroise",
"Saint-Fargeau", "Saint-Germain-des-Prés", "Saint-Gervais",
"Saint-Lambert", "Saint-Merri", "Saint-Thomas-d'Aquin", "Saint-Victor",
"Saint-Vincent-de-Paul", "Sainte-Avoie", "Sainte-Marguerite",
"Saint-Georges", "Salpêtrière", "Sorbonne", "Saint-Germain-l'Auxerrois",
"Ternes", "Val-de-Grâce", "Villette", "Vivienne", "Total"),
saturation2 = c(98.188951329533, 85.4938271604938, 83.8463463463464,
90.1460755525873, 98.1726527090667, 90.2186740262059, 92.8743271072797,
72.8549079897508, 99.2356140350877, 90.1234567901235, 114.057904044022,
NA, 87.2208980972528, 91.2562612612613, 97.9518951016991,
86.2770900920801, 91.0239726151895, 92.8305400372439, 88.6514719848053,
73.876877752942, 108.693318725755, 67.3263578578579, 85.8735259484408,
89.2100224414912, 92, 90.6120989320281, 85.8446948520848,
91.4165103088783, 97.2760978594495, 93.60892313074, 102.471730530348,
95.9062868379746, 96, 92.5484278273071, 95.0066946433545,
85.8187074829932, 101.139150713213, 92.1272297297297, 93.0625144594594,
61.8074324324324, 100.173302938197, 99.720856146949, 84.8732544128823,
84.1911355800245, 85.1122672253259, 91.8422003734504, NA,
94.612349767814, 83.2363741480137, 87.0403187718064, 92.0886931496388,
77, 110.943302180685, 100.73486307088, 66.3899425287356,
96.2527514568292, 95.7430893746874, 87.9028997984617, 48,
85.5630809345015, 92.7010730078939, 82.075822827797, 83.1727736726875,
76.2162162162162, 104.534662867996, 98.3510353194912, 78.3333333333333,
103.169134078212, 80.8779605984059, 92.63515704154, 62, 90.3902768982325,
94.1391771653151, 94.8669917042241, 94.4825319797959, 95.4279279279279,
98.2238673533848, 94.0602977590835, 87.5105365473892, 102,
92.5123935729199), numobs = c(6, 4, 4, 6, 36, 15, 4, 4, 3,
2, 16, NA, 36, 3, 32, 9, 22, 13, 11, 6, 31, 5, 15, 14, 4,
22, 3, 64, 29, 58, 7, 18, 4, 13, 23, 2, 8, 4, 47, 12, 16,
49, 50, 9, 33, 26, NA, 15, 10, 10, 23, 2, 13, 15, 2, 12,
8, 31, 1, 17, 22, 42, 7, 3, 4, 74, 4, 7, 13, 6, 2, 23, 18,
16, 17, 1, 24, 44, 8, 4, 1290)), row.names = c(NA, -81L), class = c("tbl_df",
"tbl", "data.frame"))
Neither spplot, nor ggplot2 support textured fillings. Having said that, there is a package called ggpattern which provides custom ggplot2 geoms which support filled areas with geometric and image-based patterns. See developer site for more info on ggpattern: https://coolbutuseless.github.io/package/ggpattern/index.html
With ggpattern you can plot 'hatched' or textured geom fillings. Below is a working example from the developers website:
library(maps)
crimes <- data.frame(state = tolower(rownames(USArrests)), USArrests)
crimesm <- reshape2::melt(crimes, id = 1)
states_map <- map_data("state")
p <- ggplot(crimes, aes(map_id = state)) +
geom_map_pattern(
aes(
# fill = Murder,
pattern_fill = Murder,
pattern_spacing = state,
pattern_density = state,
pattern_angle = state,
pattern = state
),
fill = 'white',
colour = 'black',
pattern_aspect_ratio = 1.8,
map = states_map
) +
expand_limits(x = states_map$long, y = states_map$lat) +
coord_map() +
theme_bw(18) +
labs(title = "ggpattern::geom_map_pattern()") +
scale_pattern_density_discrete(range = c(0.01, 0.3)) +
scale_pattern_spacing_discrete(range = c(0.01, 0.03)) +
theme(legend.position = 'none')
p
I'm performing some light analysis on an NFL kickers' dataset, and am trying to find the total number of kicks made from 18-29yds grouped by each kicker. The dataset's rows contain every made or missed field goal for each kicker, along with the distance and some other variables irrelevant to this issue. I'm using groupby() and then the sum function within the summarise function, but it is returning 1 for every kicker. I have tried different combinations, trying to use filter() as well, but the results keep returning 1 for each kicker. Pics of my code are attached. Any help is appreciated :)
Some code I have tried:
kicks20to29 <- nfl_kicks1%>%
group_by(Kicker)%>%
count(filter(nfl_kicks1$`FG Length`>=18 & nfl_kicks1$`FG Length`<=29))
kicks20to29 <- nfl_kicks1%>%
group_by(Kicker)%>%
filter(`FG Length`>=18 & `FG Length`<=29)
dput output:
structure(list(Quarter = c(1, 2, 1, 2, 2, 4), `Possession Team` = c("NE",
"NE", "NE", "NE", "NE", "NE"), `Wind Speed` = c("6", "6", "12",
"12", "12", "12"), Down = c(4, 4, 4, 4, 4, 4), Distance = c(13,
7, 2, 6, 9, 12), YardLine = c(22, 20, 2, 6, 35, 25), `FG Length` = c(39,
37, 19, 23, 52, 42), `4Q to tie or take lead` = c(0, 0, 0, 0,
0, 0), Result = c("Miss", "Miss", "Good", "Good", "Good", "Miss"
), `Success Rate` = c(0, 0, 1, 1, 1, 0), Kicker = c("A.Vinatieri",
"A.Vinatieri", "A.Vinatieri", "A.Vinatieri", "A.Vinatieri", "A.Vinatieri"
), `# career kicks in study` = c(766, 766, 766, 766, 766, 766
)), row.names = c(NA, -6L), class = c("tbl_df", "tbl", "data.frame"
))
One approach is to use the tally function, which counts the number of rows per group.
library(tidyverse)
nfl_kicks1 %>%
group_by(Kicker) %>%
dplyr::filter(`FG Length` >= 18 & `FG Length` <= 29) %>%
tally(name = "Number of Kicks")
## A tibble: 1 x 2
# Kicker `Number of Kicks`
# <chr> <int>
#1 A.Vinatieri 2
You can use group_by + summarise :
library(dplyr)
nfl_kicks1 %>%
group_by(Kicker) %>%
summarise(n_kicks = sum(`FG Length` >= 18 & `FG Length` <= 29))
I have a boxplot with a group on the left (Baseline.RT) and a group on the right (TBPM.RT). I want to rename Baseline.RT to 1-back and TBPM.RT to TBPM. I also want each group to have a different square frame. I would also like to try black and white options to fill in the values for Neutral, Positive, and Negative.
I have tried several options but did not get the result I wanted. Below is my code. Any help is welcome.
DataFrame:
data.frame(
stringsAsFactors = FALSE,
Participant = c(1, 2, 3, 4, 5, 6),
Sex = c("m", "m", "m", "f", "f", "m"),
Age = c(29, 21, 29, 22, 25, 31),
Stress = c(14, 26, 11, 19, 15, 15),
Dass21.total = c(6, 43, 4, 10, 12, 8),
Dass21Ansie = c(0, 12, 1, 3, 2, 2),
Dass.Depre = c(1, 11, 0, 1, 3, 0),
Dass.Stress = c(5, 20, 3, 6, 7, 6),
Valence = c(0, 1, 2, 0, 1, 2),
Baseline.RT = c(1.17657473346937,
0.656485061072056,0.617504973518475,0.552112912223171,
0.587283706967395,0.569011248952529),
TBPM.RT = c(1.16126499995575,
0.682658424923267,0.643632301167193,0.589782671563839,
0.705303832011063,0.691478784144668),
TotalClockChecks = c(44, 97, 44, 93, 32, 90),
TotalChecks5060 = c(13, 22, 17, 23, 10, 27),
TotalClockResets = c(18, 20, 19, 19, 18, 19),
Correct.Resets = c(16, 16, 18, 18, 12, 19),
Before.55.Resets = c(0, 2, 0, 1, 0, 0),
After.65.Resets = c(2, 2, 1, 0, 6, 0),
MeanResetTime = c(63.0026438647087,
58.9040712799639,60.9928466685597,60.4603108544334,
65.859630879724,60.5522703813385),
Accuracy.Baseline = c(0.987179487179487,
0.991489361702128,0.97907949790795,0.987234042553191,1,
0.987234042553191),
Accuracy.TBPM = c(0.968619246861925,
0.972746331236897,0.989626556016598,0.972515856236786,
0.974736842105263,0.991786447638604),
rau.Baseline = c(112.453264487601,
114.413187265486,109.508971532343,112.475825131896,
122.999999959683,112.475825131896),
rau.TBPM = c(106.447535249234,
107.58519024216,113.516946707831,107.519541719961,
108.163803190644,114.564811317506)
)
Plot:
my44 %>%
select(Participant, Valence, Baseline.RT,TBPM.RT) %>% #Select interest variables
gather(Task,RT, -Valence, -Participant) %>%
ggplot(., aes(factor(Valence), RT)) + #plot
geom_boxplot() + facet_wrap(~ Task) +
scale_x_discrete(name = element_blank(), labels=c("0" = "Neutral", "1" = "Positive", "2" = "Negative")) +
scale_fill_discrete(name="Valence",
breaks=c("0", "1", "2"),
labels=c("Neutral", "Positive",
"Negative"))
The obtained results:
Created on 2020-09-02 by the reprex package (v0.3.0)
It sounds like you're looking for something like this (although your question's input data doesn't produce the values displayed in your plot, and you seem to have a default theme set somewhere).
Your fill colours can be chosen by scale_fill_manual, but you need to map the Valence variable to the fill scale if you want the different boxes to have different colours.
If you want a frame around each facet, theme_bw does this by default, or you can use theme(panel.border = element_rect(colour = "black")).
To re-name facets, I would normally just re-name the faceting variables to the desired names in the input, but here I have shown an alternative method using the labeller parameter in facet_wrap.
my44 %>%
select(Participant, Valence, Baseline.RT,TBPM.RT) %>% #Select interest variables
gather(Task,RT, -Valence, -Participant) %>%
ggplot(., aes(factor(Valence), RT)) +
geom_boxplot(aes(fill = factor(Valence))) +
facet_wrap(~ Task,
labeller = function(x) data.frame(Task = c("1-back", "TBPM"))) +
scale_x_discrete(name = element_blank(),
labels=c("0" = "Neutral", "1" = "Positive", "2" = "Negative")) +
scale_fill_manual(name="Valence",
breaks=c("0", "1", "2"),
labels=c("Neutral", "Positive","Negative"),
values = c("gray50", "gray75", "gray95")) +
theme_bw() +
theme(legend.position = "none",
strip.background = element_blank())
I'm trying to conditionally replace values in multiple columns based on a string match in a different column but I'd like to be able to do so in a single line of code using the across() function but I keep getting errors that don't quite make sense to me. I feel like this is probably a simple solution so if anyone could point me in the right direction, that would be fantastic!
df <- data.frame("type" = c("Park", "Neighborhood", "Airport", "Park", "Neighborhood", "Neighborhood"),
"total" = c(34, 56, 75, 89, 21, 56),
"group_a" = c(30, 26, 45, 60, 3, 46),
"group_b" = c(4, 30, 30, 29, 18, 10))
# working but not concise
df %>%
mutate(total = ifelse(str_detect(type, "Park"), NA, total),
group_a = ifelse(str_detect(type, "Park"), NA, group_a),
group_b = ifelse(str_detect(type, "Park"), NA, group_b))
# concise but not working
df %>% mutate(across(total, group_a, group_b), ifelse(str_detect(type, "Park"), NA, .))
Update
We got a solution that works with my dummy dataset but is not working with my real data, so I am going to share a small snippet of my real data frame with the numbers changed and organization names hidden. When I run this line of code (df %>% mutate(across(c(Attempts, Canvasses, Completes)), ~ifelse(str_detect(long_name, "park-cemetery"), NA, .))) on these data, I get the following error message:
Error: Problem with mutate() input ..2. x Input ..2 must be a
vector, not a formula object. i Input ..2 is
~ifelse(str_detect(long_name, "park-cemetery"), NA, .).
This a small sample of the data that produces this error:
df <- structure(list(Org = c("OrgName", "OrgName", "OrgName", "OrgName",
"OrgName", "OrgName", "OrgName", "OrgName", "OrgName", "OrgName"
), nCode = c("M34", "R36", "R46", "X29", "M31", "K39", "Q12",
"Q39", "X41", "K27"), Attempts = c(100, 100, 100, 100, 100, 100,
100, 100, 100, 100), Canvasses = c(80, 80, 80, 80, 80, 80, 80,
80, 80, 80), Completes = c(50, 50, 50, 50, 50, 50, 50, 50, 50,
50), van_nocc_id = c(999, 999, 999, 999, 999, 999, 999, 999,
999, 999), van_name = c("M-Upper West Side", "SI-Rosebank", "SI-Tottenville",
"BX-park-cemetery-etc-Bronx", "M-Stuyvesant Town-Cooper Village",
"BK-Kensington", "Q-Broad Channel", "Q-Lindenwood", "BX-Wakefield",
"BK-East New York"), boro_short = c("M", "SI", "SI", "BX", "M",
"BK", "Q", "Q", "BX", "BK"), long_name = c("Upper West Side",
"Rosebank", "Tottenville", "park-cemetery-etc-Bronx", "Stuyvesant Town-Cooper Village",
"Kensington", "Broad Channel", "Lindenwood", "Wakefield", "East New York"
)), row.names = c(NA, -10L), class = "data.frame")
Final update
The curse of the misplaced closing bracket! Thanks to everyone for your help... the correct solution was df %>% mutate(across(c(Attempts, Canvasses, Completes), ~ifelse(str_detect(long_name, "park-cemetery"), NA, .)))
If you use the newly introduced function across (which is the correct way to approach this task), you have to specify inside across itself the function you want to apply. In this case the function ifelse(...) has to be a purrr-style lambda (so starting with ~). Check out across documentation and look for the arguments .cols and .fns.
df %>%
mutate(across(c(total, group_a, group_b), ~ifelse(str_detect(type, "Park"), NA, .)))
Output
# type total group_a group_b
# 1 Park NA NA NA
# 2 Neighborhood 56 26 30
# 3 Airport 75 45 30
# 4 Park NA NA NA
# 5 Neighborhood 21 3 18
# 6 Neighborhood 56 46 10
Here a data.table solution.
require(data.table)
df <- data.frame("type" = c("Park", "Neighborhood", "Airport", "Park", "Neighborhood", "Neighborhood"),
"total" = c(34, 56, 75, 89, 21, 56),
"group_a" = c(30, 26, 45, 60, 3, 46),
"group_b" = c(4, 30, 30, 29, 18, 10))
setDT(df)
df[type == "Park", c("total", "group_a", "group_b") := NA]
Update: that didn't take long to figure out! Just needed to place the columns in a vector:
# concise AND working!
df %>% mutate(across(c(total, group_a, group_b)), ifelse(str_detect(type, "Park"), NA, .))
I had tried this initially but placed the columns in quotes... don't do that :)
I have a data frame with which I am learning tidyverse methods in R that looks like this:
> glimpse(data)
Observations: 16
Variables: 6
$ True.species <fct> Badger, Blackbird, Brown hare, Domestic cat, Domestic d...
$ misidentified <dbl> 17, 16, 59, 20, 12, 24, 28, 6, 3, 7, 191, 19, 110, 21, ...
$ missed <dbl> 61, 106, 7, 24, 16, 160, 110, 12, 15, 37, 200, 58, 259,...
$ Total <dbl> 78, 122, 66, 44, 28, 184, 138, 18, 18, 44, 391, 77, 369...
$ PrMissed <dbl> 0.7820513, 0.8688525, 0.1060606, 0.5454545, 0.5714286, ...
$ PrMisID <dbl> 0.21794872, 0.13114754, 0.89393939, 0.45454545, 0.42857...
Here is the dput():
data <- structure(list(True.species = structure(c(1L, 2L, 3L, 5L, 6L,
7L, 8L, 9L, 13L, 16L, 17L, 18L, 20L, 21L, 22L, 23L), .Label = c("Badger",
"Blackbird", "Brown hare", "Crow", "Domestic cat", "Domestic dog",
"Grey squirrel", "Hedgehog", "Horse", "Human", "Jackdaw", "Livestock",
"Magpie", "Muntjac", "Nothing", "Pheasant", "Rabbit", "Red fox",
"Red squirrel", "Roe Deer", "Small rodent", "Stoat or Weasel",
"Woodpigeon"), class = "factor"), misidentified = c(17, 16, 59,
20, 12, 24, 28, 6, 3, 7, 191, 19, 110, 21, 5, 13), missed = c(61,
106, 7, 24, 16, 160, 110, 12, 15, 37, 200, 58, 259, 473, 9, 17
), Total = c(78, 122, 66, 44, 28, 184, 138, 18, 18, 44, 391,
77, 369, 494, 14, 30), PrMissed = c(0.782051282051282, 0.868852459016393,
0.106060606060606, 0.545454545454545, 0.571428571428571, 0.869565217391304,
0.797101449275362, 0.666666666666667, 0.833333333333333, 0.840909090909091,
0.51150895140665, 0.753246753246753, 0.70189701897019, 0.95748987854251,
0.642857142857143, 0.566666666666667), PrMisID = c(0.217948717948718,
0.131147540983607, 0.893939393939394, 0.454545454545455, 0.428571428571429,
0.130434782608696, 0.202898550724638, 0.333333333333333, 0.166666666666667,
0.159090909090909, 0.48849104859335, 0.246753246753247, 0.29810298102981,
0.0425101214574899, 0.357142857142857, 0.433333333333333)), row.names = c(NA,
-16L), class = "data.frame")
I managed to make a rudimentary plot of what I want with ggplot() as follows:
ggplot(data = data, aes(x = True.species, y = PrMissed)) + geom_bar(stat = "identity")
But there are three things I can't figure out how to do:
I want a stacked bar chart where the variables PrMissed and PrMisID are on top of each other. Note that PrMissed + PrMisID == 1 for each row in the data frame, so the final plot would have equally high stacks but each containing two colors (how do I specify them?), one for PrMissed and another for PrMisID.
I want the order of the bars to be in ascending order of the PrMissed variable so that Brown hare would be on one end and Small rodent on the other.
I prefer this plot to be "flipped" on its side so that the labels (the animal names like "Brown hare") are on the left side and easier to read. An added complexity is that rather than the labels simply saying the animal name, I want them to say the corresponding Total value, so for example Brown hare would get a corresponding axis label like "Brown hare (total = 66)".
I been trying for a long time a for the life of me couldn't figure out an axiomatic way to do this with ggplot(). I know the answer might be simple so please excuse my ignorance. Can anyone help? Thanks in advance.
Here's my answer which does not require the use of data.tables and is solely based on tidyverse packages:
library(ggplot2)
library(reshape2)
library(magrittr)
library(dplyr)
# order Species by PrMissed value
data$True.species <- factor(data$True.species,
levels = data[order(data$PrMissed, decreasing = F),"True.species"])
# reshape to have the stackable values and plot
melt(data,
id.vars = c("True.species", "misidentified", "missed", "Total"),
measure.vars = c("PrMissed", "PrMisID")) %>%
mutate(x_axis_text = paste(.$True.species, "(Total = ", .$Total, ")") ) %>%
ggplot(aes(x = x_axis_text, y = value, fill = variable) ) +
geom_bar(stat = "identity") +
coord_flip()
Which would result in a plot like this
Break down of the code:
Your individual points are done like this.
1) To have stackable values, they need to be all in one column, so using melt from the reshape2 package we tidy the data and create 2 new columns in the data. One is value containing the values from 0 to 1 and the other is variable indicating if that number is associated with PrMissed or PrMisID
2) Before melting the data we convert the True.species values into factor based on PrMissed values. Use decreasing = T to invert the order if you wish.
3) coord_flip() flips the x and y axis so that the species are on the y axis instead of the y axis and you can easily read them on the left side.
I can help with a data.table and ggplot2 solution:
First, you'll need to make your wide table a long one with melt. Then, you're looking for position = "stack" argument to geom_bar:
Also, please notice that naming data a table is bad idea, as there's a function called data().
require(data.table)
ggplot(melt(df[, .(True.species, PrMissed, PrMisID)],
id.vars="True.species"),
aes(x = True.species, y = value, fill = variable))+
geom_bar(position = "stack", stat = "identity")
I forgot about the sorting... (and rotation of texts, so they are readable):
ggplot(melt(df[, .(True.species, PrMissed, PrMisID)],
id.vars="True.species"),
aes(x = True.species, y = value,
fill = variable))+
geom_bar(position = "stack", stat = "identity")+
theme(axis.text.x = element_text(angle = 90))+
scale_x_discrete(limits = sort(df$True.species))