I am plotting bar charts for climate different models. I would like make a plot comparing models to observations. The climate models will plotted as bar (geom_bar()) but I would like to have the observation crossbars.
The script below makes a plot but there is something (upside down triangle) that is plotted above the graph. What is wrong with this script?, Am I missing something?
ch<-structure(list(Month = structure(c(4L, 5L, 6L, 7L, 8L, 9L, 10L,
11L, 12L, 1L, 2L, 3L), .Label = c("Oct", "Nov", "Dec", "Jan",
"Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep"), class = c("ordered",
"factor")), GCM1 = c(169.5, 157.19, 90.07, 42.97, 13.24, 1.56,
2.53, 5.99, 14.92, 46.35, 88.23, 138.02), GCM2 = c(215.01, 193.37,
131.14, 41.48, 7.63, 0.94, 0.81, 0.78, 1.88, 15.95, 99.58, 188.16
), GCM3 = c(164.83, 158.82, 97.5, 29.27, 5.47, 2.14, 3.34, 0.85,
9.94, 16.9, 57.21, 117.05), OBS = c(142.25, 138.59, 59.95, 26.48,
2.61, 0.2, 0.1, 0.4, 0.72, 11.64, 38.75, 119.82)), .Names = c("Month",
"GCM1", "GCM2", "GCM3", "OBS"), row.names = c(NA, -12L), class = "data.frame")
ch$Month<-month.abb
ch$Month<-factor(ch$Month, levels=c(month.abb[10:12],month.abb[1:9]), ordered=TRUE)
chm<-melt(ch, id="Month")
cbPalette1 <- cbbPalette <- c("#D55E00", "#56B4E9", "#009E73","#0072B2", "#CC79A7","#000000")
p<-ggplot(data=chm,aes(x=factor(Month),y=value,group=variable,fill=variable))+geom_bar(subset = .(variable != "OBS"),stat="identity",position=position_dodge())+
scale_fill_manual(values=cbPalette1)+
geom_crossbar(subset = .(variable == "OBS"),aes(ymin = min(value), ymax = max(value)), col="gray30",fatten=3)
.......
Many thanks in advance
BHH
Two things:
You are overriding the group aesthetic to just be variable, so
in the crossbar, it is ignoring the different x values (treating
it as continuous) and that is giving a weird crossbar.
I think you just want the bar itself, not any extent around it.
If so, you want to set ymin and ymax to the central value, not
to the range of all central values.
Making both those changes:
p<-ggplot(data=chm,
aes(x = Month,
y = value,
fill = variable)) +
geom_bar(subset = .(variable != "OBS"),
stat="identity",
position=position_dodge()) +
scale_fill_manual(values=cbPalette1)+
geom_crossbar(subset = .(variable == "OBS"),
aes(ymin = value, ymax = value),
col="gray30", fatten=3)
Related
Fair value gap coding in pinescript?
I have tried to write code but unable to add more functions on it.
//#version=5
indicator('Fair Value Gap Akash Mehto', overlay=true)
boxLength = input.int(title='boxLength', defval=6, group='General', inline='General')
boxTransparency = input.int(title='boxTransparency', defval=85, group='General', inline='General')
bullishFvg = low[0] > high[2]
bearishFvg = high[0] < low[2]
if bullishFvg
box.new(left=bar_index - 2, top=low[0], right=bar_index + boxLength, bottom=high[2], bgcolor=color.new(color.rgb(28, 202, 121), boxTransparency), text="FVG", text_size = "tiny", text_halign = text.align_right, text_color = color.green, border_color=color.new(color.green, boxTransparency))
if bearishFvg
box.new(left=bar_index - 2, top=low[2], right=bar_index + boxLength, bottom=high[0], bgcolor=color.new(color.rgb(240, 46, 46), boxTransparency), text="FVG", text_size = "tiny", text_halign = text.align_right, text_color = color.red, border_color=color.new(color.green, boxTransparency))
I am trying to create a table of events with gtsummary and I would like to obtain a final row counting the events of the previous rows. add_overall() and add_n() do add the total but in a column, counting the same event across groups but not the overall events.
I created this example.
x1 <- sample(c("No", "Yes"), 30, replace = TRUE, prob = c(0.85, 0.15))
x2 <- sample(c("No", "Yes"), 30, replace = TRUE, prob = c(0.9, 0.1))
x3 <- sample(c("No", "Yes"), 30, replace = TRUE, prob = c(0.75, 0.25))
y <- sample(c("A", "B"), 30, replace = TRUE, prob = c(0.5, 0.5))
df <- data.frame(as_factor(x1), as_factor(x2), as_factor(x3), as_factor(y))
colnames(df) <-c("event_1", "event_2", "event_3", "group")
tbl_summary(df, by=group, statistic = all_categorical() ~ "{n}")
example
I tried using summary_rows() function from gt package after converting the table to a gt object but there is an error when summarising because these variables are factors.
Any other ideas?
You can do this by adding a new variable to your data frame that is the row sum of each of the events. Then you can display that variable's sum in the summary table. Example below!
library(gtsummary)
#> #Uighur
library(tidyverse)
df <-
data.frame(
event_1 = sample(c(FALSE, TRUE), 30, replace = TRUE, prob = c(0.85, 0.15)),
event_2 = sample(c(FALSE, TRUE), 30, replace = TRUE, prob = c(0.9, 0.1)),
event_3 = sample(c(FALSE, TRUE), 30, replace = TRUE, prob = c(0.75, 0.25)),
group = sample(c("A", "B"), 30, replace = TRUE, prob = c(0.5, 0.5))
) |>
rowwise() |>
mutate(Total = sum(event_1, event_2, event_3))
tbl_summary(
df,
by = group,
type = Total ~ "continuous",
statistic =
list(all_categorical() ~ "{n}",
all_continuous() ~ "{sum}")
) |>
as_kable() # convert to kable to display on stack overflow
Characteristic
A, N = 16
B, N = 14
event_1
4
4
event_2
1
2
event_3
7
6
Total
12
12
Created on 2023-01-12 with reprex v2.0.2
Thank you so much (great package gtsummary). That works! I had some trouble summing over factors. If variables are factors the code
mutate(Total = sum(event_1=="Yes", event_2=="Yes", event_3=="Yes"))
does it.
I'm trying to make a map of Europe using tmap and the eurostat package.
I want to add a compass and a scale bar to the map. However they don't appear inside the graph, but outside of the map, at the bottom. Does anyone know what I'm doing wrong? I want the compass at the left top of the map, and the scale bar at the right bottom.
countries = gisco_get_countries(
year = "2016",
epsg = "3035",
resolution = "3"
)
br = c(0,40,50,65,80,150)
tm_shape(countries, bbox = c(23, 14, 74, 55) * 10e4) +
tm_fill("#E0E0E0") +
tm_shape(nuts2.sf) +
tm_fill(
"fatal_inj_30day",
breaks = br,
style = "fixed",
palette = "Blues",
alpha = .7,
title = "Fatalities per million inhabitants \n(2018-2019)"
) +
tm_compass(position = c("left","top")) +
tm_scale_bar(position = c("right","bottom")) +
tm_shape(countries) +
tm_borders(lwd = .25) +
tm_layout(
bg.color = "#F2F2F2",
outer.bg.color = "white",
legend.bg.color = "white",
legend.frame = "black",
legend.title.size = 0.8,
inner.margins = c(0, 0, 0, 0),
outer.margins = c(0, 0, 0, 0),
frame = TRUE,
frame.lwd = 0,
attr.outside = TRUE,
legend.position = c("right", "top"),
main.title = "Note: regions with 10 fatalities or less are not included in the Figure",
main.title.position = "left",
main.title.size = 0.7
)
I'm trying to improve the look of Rayshader by overlaying more recent (higher detail) satellite imagery (that I'm getting from the {leaflet} packages) but the overlay doesn't match with the 3D rendering.
Ideally I'm looking for a open-source solution that can get global satellite imagery. Bonus points if you find finer detail data for my area of interest - Hawaii.
One method using {geoviz} and {rayshader} uses the slippy_overlay() function to create a number of overlay images from either Mapbox (satellite, mapbox-streets-v8, mapbox-terrain-v2, mapbox-traffic-v1, terrain-rgb, mapbox-incidents-v1) or Stamen. Although I found mapbox-terrain-v2 the best it still lacks the detail I would like. Since it requires setting up an API for mapbox I just use stamen/watercolor below:
library(geoviz)
library(rayshader)
### Maui
lat = 20.785700
lon = -156.259204
square_km = 22
max_tiles = 10
dem <- mapzen_dem(lat, lon, square_km, max_tiles)
elev_matrix = matrix(
raster::extract(dem, raster::extent(dem), buffer=1000),
nrow = ncol(dem),
ncol = nrow(dem)
)
ambmat <- ambient_shade(elev_matrix, zscale = 30)
raymat <- ray_shade(elev_matrix, zscale = 30, lambert = TRUE)
watermap <- detect_water(elev_matrix)
overlay_img <-
slippy_overlay(dem,
image_source = "stamen",
image_type = "watercolor",
png_opacity = 0.3,
max_tiles = max_tiles)
elev_matrix %>%
sphere_shade(sunangle = 270, texture = "imhof4") %>%
add_water(detect_water(elev_matrix), color="imhof4") %>%
add_shadow(ray_shade(elev_matrix,zscale=3,maxsearch = 300),0.5) %>%
add_shadow(ambmat,0.5) %>%
add_overlay(overlay_img) %>%
plot_3d(elev_matrix,
solid = T,
water = T,
waterdepth = 0,
wateralpha = 0.5,
watercolor = "lightblue",
waterlinecolor = "white",
waterlinealpha = 0.5,
zscale= raster_zscale(dem) / 3,
fov=0,theta=135,zoom=0.75,phi=45, windowsize = c(1000,800))
I'm trying to adapt Will Bishop's workflow for getting overlays with the leaflet package but the result is very odd. Will's approach is a bit different as it fetches elevation data from USGS, which doesn't have baythmetric elevation which is must for me - so I used geoviz
library(leaflet)
# define bounding box with longitude/latitude coordinates
bbox <- list(
p1 = list(long = -156.8037, lat = 20.29737),
p2 = list(long = -155.7351, lat = 21.29577)
)
leaflet() %>%
addTiles() %>%
addRectangles(
lng1 = bbox$p1$long, lat1 = bbox$p1$lat,
lng2 = bbox$p2$long, lat2 = bbox$p2$lat,
fillColor = "transparent"
) %>%
fitBounds(
lng1 = bbox$p1$long, lat1 = bbox$p1$lat,
lng2 = bbox$p2$long, lat2 = bbox$p2$lat,
)
What's the area of my hillshade from geoviz?
dim(dem)
780 780 1
Okay so the overlay image needs to be 780 x 780 so I modify the helper functions to download the overlay with the World_Imagery base map:
define_image_size <- function(bbox, major_dim = 780) {
# calculate aspect ration (width/height) from lat/long bounding box
aspect_ratio <- abs((bbox$p1$long - bbox$p2$long) / (bbox$p1$lat - bbox$p2$lat))
# define dimensions
img_width <- ifelse(aspect_ratio > 1, major_dim, major_dim*aspect_ratio) %>% round()
img_height <- ifelse(aspect_ratio < 1, major_dim, major_dim/aspect_ratio) %>% round()
size_str <- paste(img_width, img_height, sep = ",")
list(height = img_height, width = img_width, size = size_str)
}
get_arcgis_map_image <- function(bbox, map_type = "World_Imagery", file = NULL,
width = 780, height = 780, sr_bbox = 4326) {
require(httr)
require(glue)
require(jsonlite)
url <- parse_url("https://utility.arcgisonline.com/arcgis/rest/services/Utilities/PrintingTools/GPServer/Export%20Web%20Map%20Task/execute")
# define JSON query parameter
web_map_param <- list(
baseMap = list(
baseMapLayers = list(
list(url = jsonlite::unbox(glue("https://services.arcgisonline.com/ArcGIS/rest/services/{map_type}/MapServer",
map_type = map_type)))
)
),
exportOptions = list(
outputSize = c(width, height)
),
mapOptions = list(
extent = list(
spatialReference = list(wkid = jsonlite::unbox(sr_bbox)),
xmax = jsonlite::unbox(max(bbox$p1$long, bbox$p2$long)),
xmin = jsonlite::unbox(min(bbox$p1$long, bbox$p2$long)),
ymax = jsonlite::unbox(max(bbox$p1$lat, bbox$p2$lat)),
ymin = jsonlite::unbox(min(bbox$p1$lat, bbox$p2$lat))
)
)
)
res <- GET(
url,
query = list(
f = "json",
Format = "PNG32",
Layout_Template = "MAP_ONLY",
Web_Map_as_JSON = jsonlite::toJSON(web_map_param))
)
if (status_code(res) == 200) {
body <- content(res, type = "application/json")
message(jsonlite::toJSON(body, auto_unbox = TRUE, pretty = TRUE))
if (is.null(file))
file <- tempfile("overlay_img", fileext = ".png")
img_res <- GET(body$results[[1]]$value$url)
img_bin <- content(img_res, "raw")
writeBin(img_bin, file)
message(paste("image saved to file:", file))
} else {
message(res)
}
invisible(file)
}
Now download the file, then load it
image_size <- define_image_size(bbox, major_dim = 780)
# fetch overlay image
overlay_file <- "maui_overlay.png"
get_arcgis_map_image(bbox, map_type = "World_Imagery", file = overlay_file,
# width = image_size$width, height = image_size$height,
sr_bbox = 4326)
overlay_img <- png::readPNG("maui_overlay.png")
Okay let's make the plot
elev_matrix %>%
sphere_shade(sunangle = 270, texture = "imhof4") %>%
add_water(detect_water(elev_matrix), color="imhof4") %>%
add_shadow(ray_shade(elev_matrix,zscale=3,maxsearch = 300),0.5) %>%
add_shadow(ambmat,0.5) %>%
add_overlay(overlay_img, alphacolor = 1) %>%
plot_3d(elev_matrix,
solid = T,
water = T,
waterdepth = 0,
wateralpha = 0.5,
watercolor = "lightblue",
waterlinecolor = "white",
waterlinealpha = 0.5,
zscale= raster_zscale(dem) / 3,
fov=0,theta=135,zoom=0.75,phi=45, windowsize = c(1000,800))
As you can see the overlay image is rotated to the hillshade.
Now I'm also realizing that fetching satellite with a bounding box method isn't ideal when you're trying to show bathymatrix data. It would be ideal to subset this overlay somehow programmatically but I'll probably just end up using inkscape once I've figured out how to rotate the overlay.
I tried to use the {magick}'s image_rotate() function to no avail:
library(magick)
maui <- magick::image_read("maui_overlay.png")
image_rotate(maui, 30) # -> maui_30
# image_write(maui_30, path = "maui_overlay_30.png", format = "png")
But magick has changed the dimensions:
# A tibble: 1 x 7
format width height colorspace matte filesize density
<chr> <int> <int> <chr> <lgl> <int> <chr>
1 PNG 1068 1068 sRGB TRUE 0 38x38
And will give an error with rayshader:
overlay_img <- png::readPNG("maui_overlay_30.png")
elev_matrix %>%
sphere_shade(sunangle = 270, texture = "imhof4") %>%
add_water(detect_water(elev_matrix), color="imhof4") %>%
add_shadow(ray_shade(elev_matrix,zscale=3,maxsearch = 300),0.5) %>%
add_shadow(ambmat,0.5) %>%
add_overlay(overlay_img, alphacolor = 1) %>%
plot_3d(elev_matrix,
solid = T,
water = T,
waterdepth = 0,
wateralpha = 0.5,
watercolor = "lightblue",
waterlinecolor = "white",
waterlinealpha = 0.5,
zscale= raster_zscale(dem) / 3,
fov=0,theta=135,zoom=0.75,phi=45, windowsize = c(1000,800))
Error in add_overlay(., overlay_img, alpha = 0.8) : argument 3 matches multiple formal arguments
The answer couldn't have been simpler... it needed to be transposed overlay_img = aperm(overlay_img, c(2,1,3)).
I have encountered a problem with the MFA in FactoMineR. I am working with a data set containing physical, chemical and microbiological continuous variables measured in tomato plants, taken from 2 different treatments and at 3 time points. I have accommodated my data like this:
structure(list(row.names = structure(c(1L, 4L, 7L, 10L, 13L,
16L), .Label = c("GBA1", "GBA2", "GBA3", "GBB1", "GBB2", "GBB3",
"GBC1", "GBC2", "GBC3", "GBD1", "GBD2", "GBD3", "GBE1", "GBE2",
"GBE3", "RWA1", "RWA2", "RWA3", "RWB1", "RWB2", "RWB3", "RWC1",
"RWC2", "RWC3", "RWD1", "RWD2", "RWD3", "RWE1", "RWE2", "RWE3",
"RWF1", "RWF2", "RWF3", "RWG1", "RWG2", "RWG3", "RWH1", "RWH2",
"RWH3", "RWI1", "RWI2", "RWI3", "RWJ1", "RWJ2", "RWJ3"), class = "factor"),
Trt = structure(c(2L, 2L, 2L, 2L, 2L, 1L), .Label = c("Mineral",
"Organic"), class = "factor"), Status = structure(c(1L, 1L,
1L, 1L, 1L, 1L), .Label = c("H", "S"), class = "factor"),
Humidity = c(87.21704394, 80.29885961, 65.68047337, 85.9775641,
83.33333333, 85.98568282), pH = c(5.44, 5.94, 6.64, 6.19,
6.13, 5.45), Conductivity = c(837L, 867L, 752L, 871L, 699L,
406L), Nit.N = c(436.18, 433.92, 418.1, 458.78, 411.32, 167.24
), Ammonia.N = c(3.8122, 2.6452, 1.945, 1.7116, 2.4896, 7.16
), P = c(30.95, 15.2, 20.15, 16.1, 18.35, 48.2), K = c(135,
35, 95, 40, 145, 275), Ca = c(1287.5, 1427.5, 1610, 1570,
1640, 130), Mg = c(367.5, 575, 537.5, 532.5, 590, 42.5),
S = c(705L, 924L, 603L, 962L, 626L, 111L), Sodium = c(92.5,
170, 135, 127.5, 137.5, 35), Chlorides = c(15.1, 11.1, 15.4,
13.2, 13.8, 10.8), Fe = c(1.5, 2.2, 1.7, 2, 2.1, 3.1), Mn = c(1.1,
0.55, 0.7, 0.4, 0.65, 1.9), Rhizobium = c(0, 0, 0, 0, 0,
0), Total.bacteria = c(7207207.207, 5454545.455, 22727272.73,
18918918.92, 30630630.63, 64864864.86)), .Names = c("row.names",
"Trt", "Status", "Humidity", "pH", "Conductivity", "Nit.N", "Ammonia.N",
"P", "K", "Ca", "Mg", "S", "Sodium", "Chlorides", "Fe", "Mn",
"Rhizobium", "Total.bacteria"), row.names = c(NA, 6L), class = "data.frame")
I divided the variables in categorical (first 2), then the other 16 are continuous. However, I want to treat the 2 categorical variables separately. So I wrote the following code:
>res <- MFA(Oliver, group=c(1,1,3,11,2), type=c("n", "n","s", "s","s"),ncp=5,name.group=c("Sub","Stat", "Phys", "Chem", "Microbial"))
However, it doesn't seem to work. Hence, I tried the following:
>res=MFA(Oliver,group=c(2,16),type=c(rep("n",1),rep("s",1)),ncp=5,name.group=c("cat","cont"))
and this other:
>res=MFA(Oliver,group=c(2, 3, 11,2),type=c(rep("n",1),rep("s",3)), ncp=5,name.group=c("type","Phys", "Chem", "Microbial"))
But I kept having the same problem ("not convenient group definition"). Is there anything that I can do to keep the first 2 categorical groups separately? I would really appreciate your advice on how to properly run the model!
Best wishes,
Emma
I think that the problem comes from your variable Status which is not a variable since all the values are equal to "H". So no analysis cn be done with this "variable".
You can suppress it, there is no information in this column. And then, it should work.
Francois