## ----include = FALSE---------------------------------------------------------- knitr::opts_chunk$set( collapse = TRUE, comment = "#>" ) ## ----setup, message=FALSE, warning=FALSE, echo=FALSE-------------------------- library(ggdibbler) library(tidyverse) library(sf) library(distributional) library(patchwork) library(tidygraph) library(ggraph) library(ggthemes) library(fable) library(gganimate) library(ggridges) ## ----distributional----------------------------------------------------------- dist_normal(1,3) # if transformation exists exp(3 * (2 + dist_normal(1,3))) # if transformation doesn't exist uses dist_transformed (3 * (2 + dist_normal(1,3)))^2 ## ----distributional1---------------------------------------------------------- toy_temp_eg <- toy_temp |> group_by(county_name) |> summarise(temp_dist = dist_normal(mu = mean(recorded_temp), sigma = sd(recorded_temp)/sqrt(n()))) print(head(toy_temp_eg)) ## ----figuregrid, fig.width=16, fig.height=16---------------------------------- # ggplot IDENTITY p1 <- ggplot(mpg, aes(class)) + geom_bar_sample(aes(fill = drv), position = "identity", alpha=0.7)+ theme_few() + theme(legend.position="none", aspect.ratio = 1) + ggtitle("ggplot2: identity") # ggdibbler identity p2 <- ggplot(uncertain_mpg, aes(class)) + geom_bar_sample(aes(fill = drv), alpha=0.1, position = "identity_identity")+ theme_few() + theme(legend.position="none", aspect.ratio = 1)+ ggtitle("identity_identity") p3 <- ggplot(uncertain_mpg, aes(class)) + geom_bar_sample(aes(fill = drv), alpha=0.7, position = "identity_dodge")+ theme_few() + theme(legend.position="none", aspect.ratio = 1)+ ggtitle("identity_dodge") # ggplot dodge p5 <- ggplot(mpg, aes(class)) + geom_bar_sample(aes(fill = drv), position = position_dodge(preserve="single"))+ theme_few() + theme(legend.position="none", aspect.ratio = 1)+ ggtitle("ggplot: dodge") p6 <- ggplot(uncertain_mpg, aes(class)) + geom_bar_sample(aes(fill = drv), alpha=0.1, position = "dodge_identity")+ theme_few() + theme(legend.position="none", aspect.ratio = 1)+ ggtitle("dodge_identity") p7 <- ggplot(uncertain_mpg, aes(class)) + geom_bar_sample(aes(fill = drv), position = "dodge_dodge")+ theme_few() + theme(legend.position="none", aspect.ratio = 1)+ ggtitle("dodge_dodge") # ggplot stack p9 <- ggplot(mpg, aes(class)) + geom_bar_sample(aes(fill = drv), position = "stack")+ theme_few() + theme(legend.position="none", aspect.ratio = 1)+ ggtitle("ggplot2: stack") p10 <- ggplot(uncertain_mpg, aes(class)) + geom_bar_sample(aes(fill = drv), alpha=0.1, position = "stack_identity")+ theme_few() + theme(legend.position="none", aspect.ratio = 1)+ ggtitle("stack_identity") p11 <- ggplot(uncertain_mpg, aes(class)) + geom_bar_sample(aes(fill = drv), position = "stack_dodge")+ theme_few() + theme(legend.position="none", aspect.ratio = 1)+ ggtitle("stack_dodge") (p1 | p2 | p3 ) / (p5 | p6 | p7) / (p9 | p10 | p11) ## ----forecast, fig.width=6, fig.height=4-------------------------------------- forecast <- as_tsibble(sunspot.year) |> model(ARIMA(value)) |> forecast(h = "10 years") ggplot(forecast) + geom_line_sample(aes(x = index, y = value), times=100, alpha=0.5) + theme_few() ## ----abline1, fig.width=5, fig.height=5--------------------------------------- # plot data p <- ggplot(mtcars, aes(wt, mpg)) + geom_point() + theme_few() p # Calculate slope and intercept of line of best fit # get coef and standard error summary(lm(mpg ~ wt, data = mtcars)) ## ----abline2, fig.width=8, fig.height=4--------------------------------------- # ggplot, just error estimate p1 <- p + geom_abline(intercept = 37, slope = -5) # ggdibbler for coef AND standard error p2 <- p + geom_abline_sample(intercept = dist_normal(37, 1.8), slope = dist_normal(-5, 0.56), times=30, alpha=0.3) p1 + p2 ## ----sf1---------------------------------------------------------------------- glimpse(toy_temp) ## ----sf2, fig.width=6, fig.height=4------------------------------------------- # Plot Raw Data ggplot(toy_temp) + geom_sf(aes(geometry=county_geometry), fill="white") + ggtitle("ggdibbler some error") + geom_jitter(aes(x=county_longitude, y=county_latitude, colour=recorded_temp), width=5000, height =5000, alpha=0.7) + scale_colour_distiller(palette = "OrRd") + theme_map() ## ----sf3, fig.width=6, fig.height=4------------------------------------------- # Mean data toy_temp_mean <- toy_temp |> group_by(county_name) |> summarise(temp_mean = mean(recorded_temp)) # Plot Mean Data ggplot(toy_temp_mean) + ggtitle("ggdibbler some error")+ scale_fill_distiller(palette = "OrRd") + geom_sf(aes(geometry=county_geometry, fill=temp_mean), colour="white") + theme_map() ## ----sf4---------------------------------------------------------------------- # Mean and variance data toy_temp_est <- toy_temp |> group_by(county_name) |> summarise(temp_mean = mean(recorded_temp), temp_se = sd(recorded_temp)/sqrt(n())) ## ----sf5, fig.width=6, fig.height=4------------------------------------------- # Distribution toy_temp_dist <- toy_temp_est |> mutate(temp_dist = dist_normal(temp_mean, temp_se)) |> select(county_name, temp_dist) # Plot Distribution Data ggplot(toy_temp_dist) + geom_sf_sample(aes(geometry=county_geometry, fill=temp_dist), times=50, linewidth=0) + scale_fill_distiller(palette = "OrRd") + theme_map() ## ----sf6, fig.width=6, fig.height=4------------------------------------------- ggplot(toy_temp_dist) + geom_sf_sample(aes(geometry = county_geometry, fill=temp_dist), linewidth=0, times=50) + scale_fill_distiller(palette = "OrRd") + geom_sf(aes(geometry = county_geometry), fill=NA, linewidth=1, colour="white") + theme_map() ## ----hops1-------------------------------------------------------------------- # bar chart hops <- ggplot(uncertain_mpg, aes(class)) + geom_bar_sample(aes(fill = drv), position = "stack_identity", times=30) + theme_few() + transition_states(after_stat(drawID)) animate(hops, renderer = gifski_renderer()) ## ----graph1, fig.width=6, fig.height=4---------------------------------------- set.seed(10) uncertain_edges <- tibble::tibble(from = sample(5, 20, TRUE), to = sample(5, 20, TRUE), weight = runif(20)) |> dplyr::group_by(from, to) |> dplyr::mutate(to = distributional::dist_sample(list(sample(seq(from=max(1,to-1), to = min(to+1, 5)), replace = TRUE)))) |> ungroup() head(uncertain_edges) ## ----graph2, fig.width=6, fig.height=4---------------------------------------- graph_sample <- uncertain_edges |> sample_expand(times=50) |> as_tbl_graph() ## ----graph3, fig.width=6, fig.height=4---------------------------------------- jitter = position_jitter(width=0.01, height=0.01) ggraph(graph_sample, layout = 'fr', weights = weight) + geom_edge_link(aes(group=drawID), position=jitter, alpha=0.1, linewidth=0.05) + geom_node_point(size=5) ## ----graph4------------------------------------------------------------------- # uncertainty indicated by transparency ggraph(graph_sample, layout = 'fr', weights = weight) + geom_edge_link(aes(group=drawID), alpha=0.005, linewidth=2) + geom_node_point() # Thickness = probability of an edge (thicker = more probable) ggraph(graph_sample, layout = 'fr', weights = weight) + geom_edge_parallel0(aes(group=drawID), sep = unit(0.05, "mm"), alpha=0.3, linewidth=0.1) + geom_node_point(size=15) ## ----include=FALSE, eval=FALSE------------------------------------------------ # library(spelling) # qmd <- "A_how-to-guide.Rmd" # check_spelling <- spell_check_files( # qmd, # lang = "en_GB" # ) # if (nrow(check_spelling) > 0) { # print(check_spelling) # stop("Check spelling in Qmd files!") # }