I want to create a visualization thatchampion_radar_plot <- funct
ion(df, champion_name) {
slam_win_cnt_chp = df %>% filter(WINNER == champion_name)
chp_num_wins <- slam_win_cnt_chp$NUM_WINS
l <- length(chp_num_wins)
max_v <- 10 # choosing the same maximum value for all champions
chp_df <- data.frame(rbind(max = rep(max_v, l), min = rep(0, l), chp_num_wins))
colnames(chp_df) <- slam_win_cnt_chp$TOURNAMENT
seg_n <- max_v
radarchart(chp_df, axistype = 1, caxislabels = seq(0, max_v, 1), seg = seg_n,
centerzero = TRUE, pcol = rgb(0.2, 0.5, 0.5, 0.9) , pfcol = rgb(0.2, 0.5, 0.5, 0.3),
plwd = 1, cglcol = "grey", cglty = 1, axislabcol = "blue",
vlcex = 0.8, calcex = 0.7, title = champion_name)
}
champion_radar_plot(slam_win_cnt, "Roger Federer")sv
maybe this is of help for you.
library("tidyverse")
slam_win <- read.csv("grand_slam_data.csv")
slam_win$tournament <- factor(slam_win$tournament)
slam_win %>%
filter(!tournament %in% c("Australian Open (Dec)", "Australian Open (Jan)")) %>%
group_by(tournament, winner) %>%
summarise(wins = n()) %>%
arrange(desc(tournament, wins)) %>%
slice_max(order_by = wins, n=3)
Turning tournament in a factor will you allow to group by it in either dplyr or Ggplot2.
The slice function will give you the n (you define it in the arguments) number of highest values of each group.
The next step is to plot
plot_slam <- slam_win %>%
filter(!tournament %in% c("Australian Open (Dec)", "Australian Open (Jan)")) %>%
group_by(tournament, winner) %>%
summarise(wins = n()) %>%
arrange(desc(tournament, wins)) %>%
slice_max(order_by = wins, n=3)
ggplot(plot_slam, aes(wins, reorder(tournament, wins), fill = reorder(winner, wins))) +
geom_col(position = position_dodge()) +
geom_text(aes(label = winner), position = position_dodge(0.9), hjust = 1.1)
You can add title and axis names by adding labs(title = "Grand Slam Tournaments", x = "Number of wins", y = "Tournament") and remove the legend via theme(legend.position = 'none'
This is the resulting:
Related
I want to plot the following plot
The x-axis ranges from 1 to 9, and the y-axis ranges from -0.5 to +0.5. I have also specified colours within the boxes
First I created some reproducible data with Y factors and X values. You could define the correct and incorrect colors in a new column using case_when. To create bars use geom_col and scale_fill_manual to define the labels for your colors. Here is a reproducible example:
# Data
df <- data.frame(Y = rep(c(0.3, -0.1, -0.3), each = 9),
X = rep(c(1:9), n = 3))
library(dplyr)
library(ggplot2)
df %>%
mutate(color = case_when(Y == 0.3 | Y == -0.3 ~ 'orange',
TRUE ~ 'grey')) %>%
ggplot(aes(x = X, y = factor(Y), fill = color)) +
geom_col(width = 1) +
scale_fill_manual('', values = c('orange' = 'orange', 'grey' = 'grey'),
labels = c('Correct', 'Incorrect')) +
theme_classic() +
labs(y = 'Y', x = '')
Created on 2022-12-03 with reprex v2.0.2
Update
Slightly modify the data:
df <- data.frame(Y = rep(c(0.45, 0.25, 0.05, -0.05, -0.25, -0.45), each = 9),
X = rep(c(1:9), n = 6))
library(dplyr)
library(ggplot2)
df %>%
mutate(color = case_when(Y %in% c(-0.45, 0.45, -0.25, 0.25) ~ 'orange',
TRUE ~ 'grey')) %>%
ggplot(aes(x = X, y = factor(Y), fill = color)) +
geom_col(width = 1) +
scale_fill_manual('', values = c('orange' = 'orange', 'grey' = 'grey'),
labels = c('Correct', 'Incorrect')) +
theme_classic() +
labs(y = 'Y', x = '')
Created on 2022-12-03 with reprex v2.0.2
Update to axis
You can use the following code:
df <- data.frame(Y = c(0.45, 0.25, 0.05, -0.05, -0.25, -0.45),
X = rep(9, n = 6))
library(dplyr)
library(ggplot2)
df %>%
mutate(color = case_when(Y %in% c(-0.45, 0.45, -0.25, 0.25) ~ 'orange',
TRUE ~ 'grey')) %>%
ggplot(aes(x = X, y = factor(Y), fill = color)) +
geom_col(width = 1) +
scale_fill_manual('', values = c('orange' = 'orange', 'grey' = 'grey'),
labels = c('Correct', 'Incorrect')) +
theme_classic() +
labs(y = 'Y', x = '') +
coord_cartesian(expand = FALSE, xlim = c(1, NA)) +
scale_x_continuous(breaks = seq(1, 9, by = 1))
Created on 2022-12-03 with reprex v2.0.2
I have made a graph but I don't know how to view the exact values of the bars on the graph. Here is my code in case it is needed. I also have a picture of my graph.
Step 1: Load the tidyverse and tidyquant:
install.packages("tidyverse")
install.packages("tidyquant")
library("tidyverse")
library("tidyquant")
#STEP 2: Getting stocks data:
stocks <- c("TSLA", "UPST", "PLTR", "SPOT", "SHOP", "SPY", "BND")
stocks_df <- tq_get(stocks, from = '2017-01-01')
#Step 3: Group data:
port <- tq_get(c("TSLA", "UPST", "PLTR", "SPOT", "SHOP", "SPY", "BND"),
from = '2017-01-01')%>%
group_by(symbol) %>%
tq_transmute(select = adjusted,
mutate_fun = periodReturn,
period = "daily",
col_rename = "ret")
#Step 4: Computing portfolio returns:
myport <- port %>% tq_portfolio(symbol,ret, c(0.2, 0.2, 0.2, 0.2, 0.2, 0, 0))
benchmark <- port %>% tq_portfolio(symbol, ret, c(0, 0, 0, 0, 0, 0.6, 0.4))
#Step 5: Computing portfolio measure:
mVaR <- myport %>% tq_performance(portfolio.returns,
performance_fun = VaR,
p = 0.95,
method = "historical",
portfolio_method = "single") %>%
add_column(symbol = "MyPort", .before = 1)
bVaR <- benchmark %>% tq_performance(portfolio.returns,
performance_fun = VaR,
p = 0.95,
method = "gaussian",
portfolio_method = "single") %>%
add_column(symbol = "Benchmark", .before = 1)
#Step 6: Computing portfolio measure: Expected Shortfall (ES):
mES <- myport %>% tq_performance(portfolio.returns,
performance_fun = ES,
p = 0.95,
method = "historical",
portfolio_method = "single") %>%
add_column(symbol = "MyPort", .before = 1)
bES <- benchmark %>% tq_performance(portfolio.returns,
performance_fun = ES,
p = 0.95,
method = "gaussian",
portfolio_method = "single") %>%
add_column(symbol = "Benchmark", .before = 1)
#Step 7: Combining the results into a single table using rbind (row bind):
bothVaR <- rbind(mVaR, bVaR)
bothES <- rbind(mES, bES)
results <- inner_join(bothVaR, bothES)
#Step 8: Re-shaping the table into a data frame suitable for plotting:
results <- results %>%
pivot_longer(!symbol, names_to = "measure", values_to = "value")
#Step 9: Plot the results:
results %>% ggplot(aes(x = measure, y = abs(value), fill = symbol)) +
geom_bar(stat = "identity", position = "dodge") +
labs(title = "Value at Risk Approach to Measure a Diversified Portfolio",
x = "Risk Measure", y = " ", fill = " ") + theme_minimal() +
theme(plot.title = element_text(hjust = 0.5), legend.position = "top")
I tried looking up on Google but the examples they give is for a specific set of data with different names and values. I don't know to implement it into my code for my specific script and graph.
If you want to plot the values on the plot, this could work:
library(ggrepel)
results %>% ggplot(aes(x = measure, y = abs(value), fill = symbol)) +
geom_bar(stat = "identity", position = "dodge") +
labs(title = "Value at Risk Approach to Measure a Diversified Portfolio",
x = "Risk Measure", y = " ", fill = " ") + theme_minimal() +
theme(plot.title = element_text(hjust = 0.5), legend.position = "top") +
geom_text_repel(aes(label = round(abs(value), digits = 3)),
position = position_dodge(width = 1), direction = "y", size = 2.5)
One way to visualize the values when you hover over them is to use ggplotly as follow:
install.packages("plotly")
library(plotly)
Once you load the library, you store then your plot in a variable that I name
p
and do following:
plotly(p)
I would like to place at the top of the largest column the x value (goals). So Team A would have the label "3" and Team B the label "2" on top of those respective columns.
Code:
df <- tibble ( team = rep(c('A', 'B'), each = 5),
goals = rep(1:5,2),
prob = c(.10, .15, .25, .20, .15, .20, .30, .20, .10, .05))
df %>%
ggplot(aes(x = goals, y = prob)) +
geom_col() +
facet_wrap(~team)
Another option if you want to do it all in a single pipe would be:
df %>%
group_by(team) %>%
mutate(label = ifelse(prob == max(prob), goals, "")) %>%
ggplot(aes(x = goals, y = prob)) +
geom_col() +
facet_wrap(~team) +
geom_text(aes(label = label), vjust = -0.5)
One option would be to make a separate data frame containing the "top" observations per team using e.g. group_by + slice_max. Afterwards you could pass this dataset to geom_text to add the labels for just the top observations:
df <- data.frame( team = rep(c('A', 'B'), each = 5),
goals = rep(1:5,2),
prob = c(.10, .15, .25, .20, .15, .20, .30, .20, .10, .05))
library(ggplot2)
library(dplyr, warn = FALSE)
df_lab <- df |>
group_by(team) |>
slice_max(prob, n = 1) |>
ungroup()
ggplot(df, aes(x = goals, y = prob)) +
geom_col() +
geom_text(data = df_lab, aes(label = goals), vjust = 0, nudge_y = .005) +
facet_wrap(~team)
I am trying to create a pie chart to visualize percent abundance of 9 genera. However, the labels are all clumping together. How do I remedy this? Code included below:
generaabundance2020 <- c(883, 464, 1948, 1177, 2607, 962, 2073, 620, 2670)
genera2020 <- c("Andrena", "Ceratina", "Halictus",
"Hesperapis", "Lasioglossum", "Melissodes",
"Osmia", "Panurginus", "Other")
generabreakdown2020 <- data.frame(group = genera2020, value = generaabundance2020)
gb2020label <- generabreakdown2020 %>%
group_by(value) %>% # Variable to be transformed
count() %>%
ungroup() %>%
mutate(perc = `value` / sum(`value`)) %>%
arrange(perc) %>%
mutate(labels = scales::percent(perc))
generabreakdown2020 %>%
ggplot(aes(x = "", y = value, fill = group)) +
geom_col() +
coord_polar("y", start = 0) +
theme_void() +
geom_label_repel(aes(label = gb2020label$labels), position = position_fill(vjust = 0.5),
size = 5, show.legend = F, max.overlaps = 50) +
guides(fill = guide_legend(title = "Genera")) +
scale_fill_manual(values = c("brown1", "chocolate1",
"darkgoldenrod1", "darkgreen",
"deepskyblue", "darkslateblue",
"darkorchid4", "hotpink1",
"lightpink"))
Which produces the following:
Thanks for adding your data.
There are a few errors in your code. The main one is that you didn't precalculate where to place the labels (done here in the text_y variable). That variable needs to be passed as the y aesthetic for geom_label_repel.
The second is that you no longer need
group_by(value) %>% count() %>% ungroup() because the data you provided is already aggregated.
library(tidyverse)
library(ggrepel)
generaabundance2020 <- c(883, 464, 1948, 1177, 2607, 962, 2073, 620, 2670)
genera2020 <- c("Andrena", "Ceratina", "Halictus", "Hesperapis", "Lasioglossum", "Melissodes", "Osmia", "Panurginus", "Other")
generabreakdown2020 <- data.frame(group = genera2020, value = generaabundance2020)
gb2020label <-
generabreakdown2020 %>%
mutate(perc = value/ sum(value)) %>%
mutate(labels = scales::percent(perc)) %>%
arrange(desc(group)) %>% ## arrange in the order of the legend
mutate(text_y = cumsum(value) - value/2) ### calculate where to place the text labels
gb2020label %>%
ggplot(aes(x = "", y = value, fill = group)) +
geom_col() +
coord_polar(theta = "y") +
geom_label_repel(aes(label = labels, y = text_y),
nudge_x = 0.6, nudge_y = 0.6,
size = 5, show.legend = F) +
guides(fill = guide_legend(title = "Genera")) +
scale_fill_manual(values = c("brown1", "chocolate1",
"darkgoldenrod1", "darkgreen",
"deepskyblue", "darkslateblue",
"darkorchid4", "hotpink1",
"lightpink"))
If you want to arrange in descending order of frequency, you should remember to also set the factor levels of the group variable to the same order.
gb2020label <-
generabreakdown2020 %>%
mutate(perc = value/ sum(value)) %>%
mutate(labels = scales::percent(perc)) %>%
arrange(desc(perc)) %>% ## arrange in descending order of frequency
mutate(group = fct_rev(fct_inorder(group))) %>% ## also arrange the groups in descending order of freq
mutate(text_y = cumsum(value) - value/2) ### calculate where to place the text labels
gb2020label %>%
ggplot(aes(x = "", y = value, fill = group)) +
geom_col() +
coord_polar(theta = "y") +
geom_label_repel(aes(label = labels, y = text_y),
nudge_x = 0.6, nudge_y = 0.6,
size = 5, show.legend = F) +
guides(fill = guide_legend(title = "Genera")) +
scale_fill_manual(values = c("brown1", "chocolate1",
"darkgoldenrod1", "darkgreen",
"deepskyblue", "darkslateblue",
"darkorchid4", "hotpink1",
"lightpink"))
Created on 2021-10-27 by the reprex package (v2.0.1)
You didn't provide us with your data to work with so I'm using ggplot2::mpg here.
library(tidyverse)
library(ggrepel)
mpg_2 <-
mpg %>%
slice_sample(n = 20) %>%
count(manufacturer) %>%
mutate(perc = n / sum(n)) %>%
mutate(labels = scales::percent(perc)) %>%
arrange(desc(manufacturer)) %>%
mutate(text_y = cumsum(n) - n/2)
Chart without polar coordinates
mpg_2 %>%
ggplot(aes(x = "", y = n, fill = manufacturer)) +
geom_col() +
geom_label(aes(label = labels, y = text_y))
Chart with polar coordinates and geom_label_repel
mpg_2 %>%
ggplot(aes(x = "", y = n, fill = manufacturer)) +
geom_col() +
geom_label_repel(aes(label = labels, y = text_y),
force = 0.5,nudge_x = 0.6, nudge_y = 0.6) +
coord_polar(theta = "y")
But maybe your data isn’t dense enough to need repelling?
mpg_2 %>%
ggplot(aes(x = "", y = n, fill = manufacturer)) +
geom_col() +
geom_label(aes(label = labels, y = text_y), nudge_x = 0.6) +
coord_polar(theta = "y")
Created on 2021-10-26 by the reprex package (v2.0.1)
I'm trying draw multiple density plots in one plot for comparison porpuses. I wanted them to have their confidence interval of 95% like in the following figure. I'm working with ggplot2 and my df is a long df of observations for a certain location that I would like to compare for different time intervals.
I've done some experimentation following this example but I don't have the coding knowledge to achieve what I want.
What i managed to do so far:
library(magrittr)
library(ggplot2)
library(dplyr)
build_object <- ggplot_build(
ggplot(data=ex_long, aes(x=val)) + geom_density())
plot_credible_interval <- function(
gg_density, # ggplot object that has geom_density
bound_left,
bound_right
) {
build_object <- ggplot_build(gg_density)
x_dens <- build_object$data[[1]]$x
y_dens <- build_object$data[[1]]$y
index_left <- min(which(x_dens >= bound_left))
index_right <- max(which(x_dens <= bound_right))
gg_density + geom_area(
data=data.frame(
x=x_dens[index_left:index_right],
y=y_dens[index_left:index_right]),
aes(x=x,y=y),
fill="grey",
alpha=0.6)
}
gg_density <- ggplot(data=ex_long, aes(x=val)) +
geom_density()
gg_density %>% plot_credible_interval(tab$q2.5[[40]], tab$q97.5[[40]])
Help would be much apreaciated.
This is obviously on a different set of data, but this is roughly that plot with data from 2 t distributions. I've included the data generation in case it is of use.
library(tidyverse)
x1 <- seq(-5, 5, by = 0.1)
t_dist1 <- data.frame(x = x1,
y = dt(x1, df = 3),
dist = "dist1")
x2 <- seq(-5, 5, by = 0.1)
t_dist2 <- data.frame(x = x2,
y = dt(x2, df = 3),
dist = "dist2")
t_data = rbind(t_dist1, t_dist2) %>%
mutate(x = case_when(
dist == "dist2" ~ x + 1,
TRUE ~ x
))
p <- ggplot(data = t_data,
aes(x = x,
y = y )) +
geom_line(aes(color = dist))
plot_data <- as.data.frame(ggplot_build(p)$data)
bottom <- data.frame(plot_data) %>%
mutate(dist = case_when(
group == 1 ~ "dist1",
group == 2 ~ "dist2"
)) %>%
group_by(dist) %>%
slice_head(n = ceiling(nrow(.) * 0.1)) %>%
ungroup()
top <- data.frame(plot_data) %>%
mutate(dist = case_when(
group == 1 ~ "dist1",
group == 2 ~ "dist2"
)) %>%
group_by(dist) %>%
slice_tail(n = ceiling(nrow(.) * 0.1)) %>%
ungroup()
segments <- t_data %>%
group_by(dist) %>%
summarise(x = mean(x),
y = max(y))
p + geom_area(data = bottom,
aes(x = x,
y = y,
fill = dist),
alpha = 0.25,
position = "identity") +
geom_area(data = top,
aes(x = x,
y = y,
fill = dist),
alpha = 0.25,
position = "identity") +
geom_segment(data = segments,
aes(x = x,
y = 0,
xend = x,
yend = y,
color = dist,
linetype = dist)) +
scale_color_manual(values = c("red", "blue")) +
scale_linetype_manual(values = c("dashed", "dashed"),
labels = NULL) +
ylab("Density") +
xlab("\U03B2 for AQIv") +
guides(color = guide_legend(title = "p.d.f \U03B2",
title.position = "right",
labels = NULL),
linetype = guide_legend(title = "Mean \U03B2",
title.position = "right",
labels = NULL,
override.aes = list(color = c("red", "blue"))),
fill = guide_legend(title = "Rej. area \U03B1 = 0.05",
title.position = "right",
labels = NULL)) +
annotate(geom = "text",
x = c(-4.75, -4),
y = 0.35,
label = c("RK", "OK")) +
theme(panel.background = element_blank(),
panel.border = element_rect(fill = NA,
color = "black"),
legend.position = c(0.2, 0.7),
legend.key = element_blank(),
legend.direction = "horizontal",
legend.text = element_blank(),
legend.title = element_text(size = 8))