I'm trying to assign labels to my ggplot2 facets. As I'm thinking this is a character problem, I'm using the labels exactly as they are in my dataset, so it's a little long, I apologize.
set.seed(123)
names <- c("acquisitionsmergers", "analystratings", "assets", "balanceofpayments",
"bankruptcy", "civilunrest", "corporateresponsibility", "credit",
"creditratings", "crime", "dividends", "earnings", "equityactions",
"exploration", "government", "indexes", "industrialaccidents",
"insidertrading", "investorrelations", "laborissues", "legal",
"marketing", "orderimbalances", "partnerships", "pricetargets",
"productsservices", "publicopinion", "regulatory", "revenues",
"security", "stockprices", "taxes", "technicalanalysis", "transportation",
"warconflict")
mylabels <- c("acquisitionsmergers" = "Acquisitions/Mergers",
"analystratings" = "Analyst Ratings",
"assets" = "Assets",
"balanceofpayments" = "Balance of Payments",
"bankruptcy" = "Bankruptcy",
"civilunrest" = "Civil Unrest",
"corporateresponsibility" = "Corporate Responsibility",
"credit" = "Credit",
"creditratings" = "Credit Ratings",
"crime" = "Crime",
"dividends" = "Dividends",
"earnings" = "Earnings",
"equityactions" = "Equity Actions",
"exploration" = "Exploration",
"government" = "Government",
"indexes" = "Indexes",
"industrialaccidents" = "Industrial Accidents",
"insidertrading" = "Insider Trading",
"investorrelations" = "Investor Relations",
"laborissues" = "Labor Issues",
"legal" = "Legal",
"marketing" = "Marketing",
"orderimbalances" = "Order Imbalances",
"partnerships" = "Partnerships",
"pricetargets" = "Price Targets",
"productsservices" = "Product Services",
"publicopinion" = "Public Opinion",
"regulatory" = "Regulatory",
"revenues" = "Revenues",
"security" = "Security",
"stockprices" = "Stockprices",
"taxes" = "Taxes",
"technicalanalysis" = "Technical Analysis",
"transportation" = "Transportation",
"warconflict" = "War Conflict")
df <- data.frame(item = rep(names, each=5), value=rnorm(5*35,5,2), date = rep(seq(as.Date("2000/1/1"), by = "month", length.out = 5),35))
Then,
library(ggplot2)
ggplot(df, aes(x=date, y=value, color=item)) +
geom_line() +
facet_wrap( ~ item, ncol=4, scales="free_y", labeller = mylabels)
Produces
Error in cbind(labels = list(), list(`{`, if (!is.null(.rows) || !is.null(.cols)) { :
number of rows of matrices must match (see arg 2)
I've used labeller before without problems, so I'm not sure why it's throwing this error. I checked a few things, such as making sure there is a match:
all(names(mylabels) %in% names)
length(mylabels) == length(names)
Thanks for any help!
What about this?
df$item <- factor(df$item,
labels = c("Acquisitions/Mergers","Analyst Ratings","Assets", "Balance of Payments","Bankruptcy", "Civil Unrest",
"Corporate Responsibility", "Credit", "Credit Ratings", "Crime", "Dividends", "Earnings", "Equity Actions",
"Exploration", "Government", "Indexes", "Industrial Accidents", "Insider Trading", "Investor Relations",
"Labor Issues", "Legal", "Marketing", "Order Imbalances","Partnerships", "Price Targets",
"Product Services", "Public Opinion","Regulatory", "Revenues","Security", "Stockprices",
"Taxes", "Technical Analysis", "Transportation", "War Conflict"))
ggplot(df, aes(x=date, y=value, color=item)) +
geom_line() +
facet_wrap( ~ item, ncol=4, scales="free_y")
UPDATE
to address the questions in the comment
First, are the label factors taken as the unique order? In other words, the original "item" vector in the dataframe should be sorted so it is in the same order as labels?
Answer
The order of levels in the labels vector must be the same as the order of levels in item vector.
Below are the levels of item
levels(df$item)
[1] "acquisitionsmergers" "analystratings" "assets" "balanceofpayments" "bankruptcy"
[6] "civilunrest" "corporateresponsibility" "credit" "creditratings" "crime"
[11] "dividends" "earnings" "equityactions" "exploration" "government"
[16] "indexes" "industrialaccidents" "insidertrading" "investorrelations" "laborissues"
[21] "legal" "marketing" "orderimbalances" "partnerships" "pricetargets"
[26] "productsservices" "publicopinion" "regulatory" "revenues" "security"
[31] "stockprices" "taxes" "technicalanalysis" "transportation" "warconflict"
I usually copy paste them inside labels add commas, remove the numbers and change the names as I like.
There is another way, below, to change the names of the levels of item using dplyr and forcats
library(dplyr)
library(forcats)
df <- df %>%
mutate(item_update = item) %>% # create new column called item_update to change the names of item levels
mutate(item_update = fct_recode(item_update,
"Acquisitions/Mergers" = "acquisitionsmergers" ,
"Analyst Ratings" = "analystratings" ,
"Assets" = "assets",
"Balance of Payments" = "balanceofpayments",
"Bankruptcy" = "bankruptcy",
"Civil Unrest" = "civilunrest",
"Corporate Responsibility" = "corporateresponsibility",
"Credit" = "credit",
"Credit Ratings" = "creditratings",
"Crime" = "crime",
"Dividends" = "dividends",
"Earnings" = "earnings",
"Equity Actions" = "equityactions",
"Exploration" = "exploration",
"Government" = "government",
"Indexes" = "indexes",
"Industrial Accidents" = "industrialaccidents",
"Insider Trading" = "insidertrading",
"Investor Relations" = "investorrelations",
"Labor Issues" = "laborissues",
"Legal" = "legal" ,
"Marketing" = "marketing",
"Order Imbalances" = "orderimbalances",
"Partnerships" = "partnerships",
"Price Targets" = "pricetargets",
"Product Services" = "productsservices",
"Public Opinion" = "publicopinion" ,
"Regulatory" = "regulatory",
"Revenues" = "revenues",
"Security" = "security",
"Stockprices" = "stockprices",
"Taxes" = "taxes",
"Technical Analysis" = "technicalanalysis",
"Transportation" = "transportation" ,
"War Conflict" = "warconflict"
))
and we can plot it as below
ggplot(df, aes(x=date, y=value, color=item)) +
geom_line() +
facet_wrap( ~ item_update, ncol=4, scales="free_y")
Second, does this appear to be a bug, which I should file with the ggplot2 page?
Answer
It is not a bug.
Your approach will work fine if you edit mylabels to be
mylabels <- c(acquisitionsmergers = "Acquisitions/Mergers",
analystratings = "Analyst Ratings",
assets = "Assets",
balanceofpayments = "Balance of Payments",
bankruptcy = "Bankruptcy",
civilunrest = "Civil Unrest",
corporateresponsibility = "Corporate Responsibility",
credit = "Credit",
creditratings = "Credit Ratings",
crime = "Crime",
dividends = "Dividends",
earnings = "Earnings",
equityactions = "Equity Actions",
exploration = "Exploration",
government = "Government",
indexes = "Indexes",
industrialaccidents = "Industrial Accidents",
insidertrading = "Insider Trading",
investorrelations = "Investor Relations",
laborissues = "Labor Issues",
legal = "Legal",
marketing = "Marketing",
orderimbalances = "Order Imbalances",
partnerships = "Partnerships",
pricetargets = "Price Targets",
productsservices = "Product Services",
publicopinion = "Public Opinion",
regulatory = "Regulatory",
revenues = "Revenues",
security = "Security",
stockprices = "Stockprices",
taxes = "Taxes",
technicalanalysis = "Technical Analysis",
transportation = "Transportation",
warconflict = "War Conflict")
and the plot to be
ggplot(df, aes(x=date, y=value, color=item)) +
geom_line() +
facet_wrap( ~ item, ncol=4, scales="free_y", labeller = labeller(item = mylabels))
Related
I wrote this code for my R assignment, and every time I run it, it crashes. I am guessing there is an error that's making it terminate.
Anyone can tell me what it is?
library(shiny)
library(shinythemes) library(tidyverse) library(DT)
load("~/Desktop/Yasmine Nahdi - Fifa Analysis - FINAL/fifa.RData")
main_page <- tabPanel( title = "Player Analysis", titlePanel("Player Analysis"), sidebarLayout(
sidebarPanel(
title = "Inputs",
sliderInput("year", h4("Year"), sep = "",
min = 2017, max = 2021,
value = c(2018, 2020), step = 1),
numericInput("max_country", h4("Nationality/Country"),
min = 2, max = 12, step = 1, value = 6),
selectInput("short_name", h4("Player"),
choices = c("All players", as.character(unique(fifa$short_name))),
selected = c("All players"), multiple = TRUE),
selectInput("team_position", h4("Player positions"),
choices = c("All positions", as.character(unique(fifa$team_position)) ),
selected = c("All positions"), multiple = TRUE)
),
mainPanel(
tabsetPanel(
tabPanel(
title = "Plots",
fluidRow(column(6, plotOutput("playerage")),
column(6, plotOutput("weightvsmovement"))),
fluidRow(column(6, plotOutput("playerBMI")),
column(6, plotOutput("movementvsBMI"))),
fluidRow(column(6, plotOutput("nationalitybyposition")),
column(6, plotOutput("valuebyposition"))))
)
)
) )
about_page <- tabPanel( title = "About" )
ui <- navbarPage( theme = shinytheme('united'), title = "Fifa Career Mode Analysis", main_page, about_page )
server <- function(input, output){ data <- reactive({
if(input$short_name == "All players"){
fifa %>%
filter(year >= input$year[1],
year <= input$year[2])
} else {
fifa %>%
filter(year >= input$year[1],
year <= input$year[2],
Player %in% input$short_name)
} })
# (1) General Analysis : Player-focused
#distribution of players ages output$playerage <- renderPlot({
data() %>%
ggplot(aes(x = age)) + geom_histogram(binwidth = 0.1) +
geom_vline(aes(xintercept = mean(age)), linetype = "dashed", size = 1) +
theme_minimal() +
ggtitle("Distribution of Players' age") })
#player weight vs movement output$weightvsmovement <- renderPlot({
data() %>%
ggplot(aes(x= weight_kg, y=Movement, color=overall)) +
geom_point() +
ggtitle("Players' movement in relation to their weight(kg)") })
#distribution of player BMI output$playerBMI <- renderPlot({
data() %>%
mutate(BMI = weight_kg / (height_cm**2) *10000) %>%
ggplot(aes(x = BMI)) +
geom_histogram(aes(y = ..density..)) +
geom_density(color = "red") +
geom_vline(aes(xintercept = mean(BMI)), linetype = "dashed", size = 1) +
theme_minimal() +
ggtitle("Distribution of Players' BMI") +
labs(y= "Density", x = "BMI") })
#movement by BMI output$movementvsBMI <- renderPlot({
data() %>%
mutate(BMI = weight_kg / (height_cm**2) *10000) %>%
ggplot(aes(x = BMI, y= Movement)) +
geom_point() +
geom_smooth( se =F) +
ggtitle("Players' movement in relation to their BMI") })
#players preferred foot output$preferredfoot <- renderPlot({
data() %>%
ggplot(aes(x = preferred_foot)) +
geom_bar() +
theme_minimal() +
ggtitle("Player's preferred foot count") +
labs(x= "Preferred foot", y="Number of players") })
# Correlation between player position, age, and performance
attackers <- c("ST","CF","RW","LW","LF","RF", "LS") midfielders <- c("CM","CAM","CDM","LM","RM","LAM","RAM","LCM","RCM","RDM","LDM") defenders <- c("CB","LB","RB","RWB","LWB","RCB","LCB") other <- c("SUB", "RES")
filter_position <- reactive({
if(input$team_position == "All positions"){
fifa %>%
filter(year >= input$year[1],
year <= input$year[2])
} else {
fifa %>%
filter(year >= input$year[1],
year <= input$year[2],
team_position %in% input$team_position)
} })
output$positionageperf <- renderPlot({
fifa <- fifa %>%
mutate(Position = case_when(
team_position %in% attackers ~ "Attacker",
team_position %in% midfielders ~ "Midfielder",
team_position %in% defenders ~ "Defender",
team_position %in% other ~ "Other"))
data() %>%
filter (Position %in% c("Attacker", "Midfielder", "Defender")) %>%
ggplot(aes(x = age, y = overall, colour = Position )) + geom_point() +
theme_minimal() + geom_smooth( se = F) + ggtitle("Analysis of player's performance with age") + xlab("Player age") + ylab("Player overall performance") })
#Player analysis by position #Most common player nationalities based on position output$nationalitybyposition <- renderPlot({
filter_position() %>%
group_by(nationality) %>%
mutate(nat_number = n()) %>%
filter(nat_number > 10) %>%
ggplot(aes(y= reorder(nationality, nat_number))) + geom_bar() + theme_minimal() + ggtitle("Most common nationality of selected player position (by year/period))") + xlab("Number of players") + ylab("Country") })
#highest valued player by position output$valuebyposition <- renderPlot({
filter_position() %>%
arrange(desc(value_eur)) %>%
filter (value_eur > 34500000) %>%
ggplot(aes(x = short_name, y=value_eur)) +
geom_point() +
ggtitle("Highest valued player by position") +
xlab("Player name") +
ylab("Value (euros)") })
#(2) League analysis
premierLeague <- c("Arsenal", "Aston Villa", "Brighton & Hove Albion", "Burnley", "Chelsea", "Crystal Palace", "Everton", "Fulham", "Leeds United", "Leicester City", "Liverpool", "Manchester City", "Manchester United", "Newcastle United", "Sheffield United", "Southampton", "Tottenham Hotspur", "West Bromwich Albion", "West Ham United", "Wolverhampton Wanderers") bundesliga <- c("1. FC Köln", "1. FSV Mainz 05", "DSC Arminia Bielefeld", "Borussia Dortmund", "FC Augsburg", "FC Bayern München", "FC Schalke 04", "Eintracht Frankfurt", "Hertha BSC", "Bayer 04 Leverkusen", "Borussia Mönchengladbach", "RB Leipzig", "SC Freiburg", "TSG 1899 Hoffenheim", "1. FC Union Berlin", "VfB Stuttgart", "VfL Wolfsburg", "SV Werder Bremen") laliga <- c("Athletic Club de Bilbao", "Atlético Madrid", "CA Osasuna", "Cádiz CF", "Deportivo Alavés", "Elche CF", "FC Barcelona", "Getafe CF", "Granada CF", "Levante UD", "Real Valladolid CF", "RC Celta", "Real Betis", "Real Madrid", "Real Sociedad", "SD Eibar", "SD Huesca", "Sevilla FC", "Valencia CF", "Villarreal CF") seriea <- c("Atalanta", "Benevento", "Bologna", "Cagliari", "Crotone", "Fiorentina", "Genoa","Hellas Verona","Inter", "Spezia", "Lazio", "Milan", "Napoli", "Parma", "Juventus", "Roma","Sampdoria","Sassuolo","Torino", "Udinese") ligue1 <- c("Angers SCO", "AS Monaco", "AS Saint-Étienne", "FC Girondins de Bordeaux", "Dijon FCO", "FC Lorient", "FC Metz", "FC Nantes", "LOSC Lille", "Montpellier HSC", "Nîmes Olympique", "OGC Nice", "Olympique Lyonnais", "Olympique de Marseille", "Paris Saint-Germain", "Racing Club de Lens", "Stade Rennais FC", "Stade Brestois 29", "Stade de Reims", "RC Strasbourg Alsace")
FifaLeague <- fifa %>% mutate(League = case_when(
club_name %in% bundesliga ~ "Bundesliga",
club_name %in% premierLeague ~ "Premier League",
club_name %in% laliga ~ "La Liga",
club_name %in% seriea ~ "Serie A",
club_name %in% ligue1 ~ "Ligue 1" ))
FifaLeague <- na.omit(FifaLeague)
filter_league <- reactive({
FifaLeague %>%
filter(year >= input$year[1],
year <= input$year[2]) }) }
shinyApp(ui = ui, server = server)
This code is for an assignment I am doing to analyze the FIFA 2017 to 2021 players. the idea is to create a shiny app where the user can select inputs and the plots get updated.
Let me know if there is anything else I can do to explain further.
Thank you!
I am creating an RShiny app that centres around a network drawn in ggiraph. The network is very large and detailed so ideally I'd like it to fill as much of the page as possible.
I've had a lot of problems getting ggiraph to scale properly, and also with margins/padding in RShiny. I've gotten this far with the code but it's still leaving huge amounts of whitespace
library(tidyverse)
library(ggiraph)
dt <-
structure(list(vName = c("Travel (people, not goods)", "Distribution of goods (logistics)",
"Financial services", "Emergency services", "Employment provision",
"Road conditions and safety", "Clothing provision", "Physical security",
"Goods and services provision", "Observance of religion", "Tourism",
"Social interaction", "Societal hazard regulation", "Law and order",
"Foster social cohesion", "Governance", "Community activities and engagement",
"Communication systems", "Housing provision", "Learning and education",
"Technological hazard regulation", "Recreational activities",
"Ceremonies and services for major life events", "Public health",
"Biological hazard regulation", "Historical and cultural value contribution",
"Animal welfare", "Planning activities", "Food provision", "Waste management",
"Energy supply", "Sanitation provision", "Hydrometeorological hazard regulation",
"Environmental and geohazard regulation", "Clean water", "Environmental conservation",
"Clean air"), x = c(-2.98858409427524, -2.81640877118298, -2.74123849093864,
-2.65386726001767, -2.28398121105892, -2.14920295612388, -2.00485883548675,
-1.8515913089343, -1.69008255335043, -1.521051426422, -1.34525026708241,
-1.08643400771279, -0.897560522159429, -0.704692093555197, -0.508687158038456,
-0.310418111994458, -0.110767429115102, 0.0893762673942864, 0.28912215997901,
0.487581201665836, 0.683870073113174, 0.87711511416821, 1.06645621243203,
1.25105063152523, 1.4300767620147, 1.74479084369789, 1.90363064894277,
2.05399760378407, 2.19522244146318, 2.32667658577832, 2.44777494880796,
2.55797853507279, 2.65679684054522, 2.75437446946491, 2.92721942501146,
2.96449908915101, 2.98858409427524), y = c(-0.261467228242974,
-1.03336423085163, -1.21885665104493, -1.39892407449664, -1.94510406598975,
-2.09306632799546, -2.23171258224949, -2.36042572954096, -2.47863288182427,
-2.58580791208079, -2.68147379605222, -2.79636570335232, -2.86258364228207,
-2.91606053662828, -2.95655836662271, -2.98389688088342, -2.99795439869375,
-2.99866835158986, -2.98603556184602, -2.96011225661834, -2.92101381768388,
-2.86891426788911, -2.80404549659329, -2.72669622755457, -2.63721073385225,
-2.44043129625646, -2.31866132766425, -2.18657125281782, -2.04474899009546,
-1.89382577477205, -1.73447334946035, -1.56740097425861, -1.393352269912,
-1.18887395545529, -0.65680015060565, -0.460157745151427, -0.261467228242978
)), class = "data.frame", row.names = c(NA, -37L))
ui <-
fillPage(
tags$body(tags$div(id="ppitest", style="width:1in;visible:hidden;padding:0px")),
tags$script('$(document).on("shiny:connected", function(e) {
var w = window.innerWidth;
var h = window.innerHeight;
var d = document.getElementById("ppitest").offsetWidth;
var obj = {width: w, height: h, dpi: d};
Shiny.onInputChange("pltChange", obj);
});
$(window).resize(function(e) {
var w = $(this).width();
var h = $(this).height();
var d = document.getElementById("ppitest").offsetWidth;
var obj = {width: w, height: h, dpi: d};
Shiny.onInputChange("pltChange", obj);
});
'),
girafeOutput("plot")
)
server <- function(input, output, session) {
output$plot <- renderGirafe({
myPlot <-
dt %>%
ggplot() +
geom_point_interactive(aes(x = x, y = y, tooltip = vName)) +
coord_equal() +
theme_void()
return(girafe(code = print(myPlot),
width_svg = (1.0*input$pltChange$width/input$pltChange$dpi),
height_svg = (1.0*input$pltChange$height/input$pltChange$dpi)))
})
}
shinyApp(ui, server)
It seems to me you want to stop the rescaling. See https://davidgohel.github.io/ggiraph/articles/offcran/customizing.html#size-options-1
server <- function(input, output, session) {
output$plot <- renderGirafe({
myPlot <-
dt %>%
ggplot() +
geom_point_interactive(aes(x = x, y = y, tooltip = vName)) +
coord_equal() +
theme_void()
return(girafe(
code = print(myPlot),
options = list(opts_sizing(rescale = FALSE)),
width_svg = (1.0 * input$pltChange$width / input$pltChange$dpi),
height_svg = (1.0 * input$pltChange$height / input$pltChange$dpi)
))
})
}
I am creating an interactive graph using ggplot2 and plotly in R, the code is below.
I want to reorder the barchart column values so that they are sorted in descending order,
currently they are sorted alphabetically.
Edit: I might not have made what I wanted clear. Currently, the midfielder with the most points is Salah, but the top row in my midfielder column is currently Alli. I would like to sort the column so that the values are in descending order of points rather than alphabetical.
Would someone please inform me how I can do this?
I have saved the finished graph & csv file at the below locations:
IG: https://ianfm94.github.io/Premier_League_Stats/Top_100_Fantasy_PL_Pointscorers.html
CSV File: https://github.com/Ianfm94/Premier_League_Stats/blob/master/CSV_Files/2020-06-01_updated_fpl_stats.csv
rm(list=ls())
# Required packages, you might need to install these
library(ggplot2)
library(dplyr)
library(plotly)
library(tibble)
## Fantasy_PL Data
fpl_data = read.csv('2020-06-01_updated_fpl_stats.csv',
header = T, fileEncoding = "UTF-8-BOM")
attach(fpl_data)
#View(fpl_data)
# Interactive Plot Workings
top_100_points = total_points[0:100]
top_100_player_pos = factor(player_pos)[0:100]
top_100_surnames = factor(web_name)[0:100]
top_100_team = factor(team_name)[0:100]
color_table = tibble(
Team_Name = c("Arsenal", "Aston Villa", "Bournemouth", "Brighton & Hove Albion",
"Burnley", "Chelsea", "Crystal Palace", "Everton",
"Leicester City", "Liverpool", "Manchester City",
"Manchester United", "Newcastle United", "Norwich City",
"Sheffield United", "Southampton", "Tottenham Hotspurs",
"Watford", "West Ham United", "Wolverhampton Wanderers"),
Team_Color = c("#EF0107", "#670E36", "#B50E12", "#0057B8",
"#6C1D45", "#034694", "#1B458F", "#003399",
"#003090", "#C8102E", "#6CABDD", "#DA291C",
"#241F20", "#FFF200", "#EE2737", "#D71920",
"#132257", "#FBEE23", "#7A263A", "#FDB913")
)
position_table = tibble(
Position_Name = c("Goalkeeper", "Defender", "Midfielder", "Striker"),
)
fpl_df = data.frame(y = top_100_points,
x = top_100_player_pos,
z = top_100_surnames,
w = top_100_team,
stringsAsFactors = F)
fpl_df$w = factor(fpl_df$w, levels = color_table$Team_Name)
fpl_df$x = factor(fpl_df$x, levels = position_table$Position_Name)
names(fpl_df)[names(fpl_df) == "x"] = "Position_Name"
names(fpl_df)[names(fpl_df) == "y"] = "Total_Points_by_Position"
names(fpl_df)[names(fpl_df) == "z"] = "Player_Surname"
names(fpl_df)[names(fpl_df) == "w"] = "Team_Name"
#View(fpl_df)
plot_fpl_1 = ggplot(fpl_df, aes(x = Position_Name,
y = Total_Points_by_Position,
z = Player_Surname,
fill = Team_Name)) +
geom_col() +
scale_fill_manual(values = color_table$Team_Color) +
labs(title = "Top 100 Fantasy PL Pointscorer by Position & Team",
y = "Total Points of Position",
x = "Player Positions",
fill = "Team Name") +
theme_bw() +
theme(plot.title = element_text(size = 14,
face = "bold",
color = "black"),
legend.title = element_text(color = "navy",
face = "bold",
size = 10))
plot_fpl_1 = ggplotly(plot_fpl_1)
plot_fpl_1
You can use forcats::fct_reorder to change the order of z. See below:
Libraries:
# Required packages, you might need to install these
library(ggplot2)
library(dplyr)
library(plotly)
library(tibble)
library(RCurl)
library(forcats)
Data:
## Fantasy_PL Data
csvurl <- getURL("https://raw.githubusercontent.com/Ianfm94/Premier_League_Stats/master/CSV_Files/2020-06-01_updated_fpl_stats.csv")
fpl_data <- read.csv(text = csvurl)
attach(fpl_data)
# Interactive Plot Workings
top_100_points = total_points[0:100]
top_100_player_pos = factor(player_pos)[0:100]
top_100_surnames = factor(web_name)[0:100]
top_100_team = factor(team_name)[0:100]
color_table = tibble(
Team_Name = c("Arsenal", "Aston Villa", "Bournemouth", "Brighton & Hove Albion",
"Burnley", "Chelsea", "Crystal Palace", "Everton",
"Leicester City", "Liverpool", "Manchester City",
"Manchester United", "Newcastle United", "Norwich City",
"Sheffield United", "Southampton", "Tottenham Hotspurs",
"Watford", "West Ham United", "Wolverhampton Wanderers"),
Team_Color = c("#EF0107", "#670E36", "#B50E12", "#0057B8",
"#6C1D45", "#034694", "#1B458F", "#003399",
"#003090", "#C8102E", "#6CABDD", "#DA291C",
"#241F20", "#FFF200", "#EE2737", "#D71920",
"#132257", "#FBEE23", "#7A263A", "#FDB913")
)
position_table = tibble(
Position_Name = c("Goalkeeper", "Defender", "Midfielder", "Striker"),
)
fpl_df = data.frame(y = top_100_points,
x = top_100_player_pos,
z = top_100_surnames,
w = top_100_team,
stringsAsFactors = F)
fpl_df$w = factor(fpl_df$w, levels = color_table$Team_Name)
fpl_df$x = factor(fpl_df$x, levels = position_table$Position_Name)
names(fpl_df)[names(fpl_df) == "x"] = "Position_Name"
names(fpl_df)[names(fpl_df) == "y"] = "Total_Points_by_Position"
names(fpl_df)[names(fpl_df) == "z"] = "Player_Surname"
names(fpl_df)[names(fpl_df) == "w"] = "Team_Name"
Plot:
plot_fpl_1 = ggplot(fpl_df, aes(x = Position_Name,
y = Total_Points_by_Position,
z = fct_reorder(Player_Surname, -Total_Points_by_Position),
fill = Team_Name)) +
geom_col() +
scale_fill_manual(values = color_table$Team_Color) +
labs(title = "Top 100 Fantasy PL Pointscorer by Position & Team",
y = "Total Points of Position",
x = "Player Positions",
fill = "Team Name") +
theme_bw() +
theme(plot.title = element_text(size = 14,
face = "bold",
color = "black"),
legend.title = element_text(color = "navy",
face = "bold",
size = 10))
plot_fpl_2 = ggplotly(plot_fpl_1)
plot_fpl_2
I wanna create a pie chart of crime types,and add a legend on the right hand,but I tried many times to avoid overlapping,doesn't work at all.
table(dd$Primary.Type.new)
ARSON ASSAULT BATTERY BURGLARY
833 30743 91237 29298
CRIMINAL DAMAGE CRIMINAL TRESPASS DECEPTIVE PRACTICE HOMICIDE
57539 14353 17472 640
KIDNAPPING MOTOR VEHICLE THEFT NARCOTOCS OFFENSE INVOLVING CHILDREN
517 23724 55685 3347
OTHER OFFENSE PUBLIC OFFENSE PUBLIC PEACE VIOLATION ROBBERY
30878 3833 3632 18891
SEX_CRIME THEFT WEAPONS VIOLATION
9331 103255 4792
Type <- table(dd$Primary.Type.new)
Here's that from dput():
structure(c(ARSON = 833L, ASSAULT = 30743L, BATTERY = 91237L,
BURGLARY = 29298L, `CRIMINAL DAMAGE` = 57539L, `CRIMINAL TRESPASS` = 14353L,
`DECEPTIVE PRACTICE` = 17472L, HOMICIDE = 640L, KIDNAPPING = 517L,
`MOTOR VEHICLE THEFT` = 23724L, NARCOTOCS = 55685L, `OFFENSE INVOLVING CHILDREN` = 3347L,
`OTHER OFFENSE` = 30878L, `PUBLIC OFFENSE` = 3833L, `PUBLIC PEACE VIOLATION` = 3632L,
ROBBERY = 18891L, `SEX CRIME` = 9331L, THEFT = 103255L, `WEAPONS VIOLATION` = 4792L
), .Dim = 19L, .Dimnames = list(. = c("ARSON", "ASSAULT", "BATTERY",
"BURGLARY", "CRIMINAL DAMAGE", "CRIMINAL TRESPASS", "DECEPTIVE PRACTICE",
"HOMICIDE", "KIDNAPPING", "MOTOR VEHICLE THEFT", "NARCOTOCS",
"OFFENSE INVOLVING CHILDREN", "OTHER OFFENSE", "PUBLIC OFFENSE",
"PUBLIC PEACE VIOLATION", "ROBBERY", "SEX CRIME", "THEFT", "WEAPONS VIOLATION"
)), class = "table") -> Type
piepercent<- round(100*Type/sum(Type), 1)
pie(Type, edges = 200, radius = 0.8,
clockwise = FALSE,angle = 45, col = rainbow(length(Type)), main = "Pie Chart of Primary Crime Types", labels = piepercent,labelcex = 0.8)
legend("right", inset = .05, title = "Primary Crime Type",legend= dd$Primary.Type.new,fill = rainbow(length(Type)), horiz=FALSE,cex = 0.6)
I tried to use par(), but doestn't work.
and BTW how can I change the labels into percentage? such as convert 20.7 into 20.7%.
Thank you very much.
Update
I also tried 3D piechart
library(plotrix)
pie3D(Type,labels = piepercent,explode = 0.1, main = "3D Pie Chart of
Primary Crime Types", labelcex = 0.8)
legend("bottom", inset = .05, title = "Primary Crime Type",legend= dd$Primary.Type.new,fill = rainbow(length(Type)), horiz=TRUE,cex = 0.6)
I hesitate to post this since this is an absolutely terrible use case for a pie chart, but it's possible to make it a bit more readable and color-blind friendly:
structure(c(ARSON = 833L, ASSAULT = 30743L, BATTERY = 91237L,
BURGLARY = 29298L, `CRIMINAL DAMAGE` = 57539L, `CRIMINAL TRESPASS` = 14353L,
`DECEPTIVE PRACTICE` = 17472L, HOMICIDE = 640L, KIDNAPPING = 517L,
`MOTOR VEHICLE THEFT` = 23724L, NARCOTOCS = 55685L, `OFFENSE INVOLVING CHILDREN` = 3347L,
`OTHER OFFENSE` = 30878L, `PUBLIC OFFENSE` = 3833L, `PUBLIC PEACE VIOLATION` = 3632L,
ROBBERY = 18891L, `SEX CRIME` = 9331L, THEFT = 103255L, `WEAPONS VIOLATION` = 4792L
), .Dim = 19L, .Dimnames = list(. = c("ARSON", "ASSAULT", "BATTERY",
"BURGLARY", "CRIMINAL DAMAGE", "CRIMINAL TRESPASS", "DECEPTIVE PRACTICE",
"HOMICIDE", "KIDNAPPING", "MOTOR VEHICLE THEFT", "NARCOTOCS",
"OFFENSE INVOLVING CHILDREN", "OTHER OFFENSE", "PUBLIC OFFENSE",
"PUBLIC PEACE VIOLATION", "ROBBERY", "SEX CRIME", "THEFT", "WEAPONS VIOLATION"
)), class = "table") -> Type
Order the slices (IMPORTANT):
Type <- sort(Type, decreasing = TRUE)
Proper % and decent labels:
piepercent <- scales::percent(as.numeric(Type/sum(Type)))
Margins:
par(mar = c(1, 1, 1, 1)) # bltr
pie(
Type,
edges = 200,
radius = 0.8,
clockwise = TRUE, # IMPORTANT
angle = 45,
col = viridis::viridis_pal(option = "magma", direction=-1)(length(Type)), # BETTER COLOR PALETTE
labels = tail(piepercent, -7), # NEVER DISPLAY OVERLAPPING LABELS
cex = 0.7
)
legend(
x = 1.2, # DELIBERATE POSITION
y = 0.5, # DELIBERATE POSITION
inset = .05,
title = "Primary Crime Type",
legend = names(Type), # YOU WERE PASSING IN _ALL_ THE REPEAT NAMES
fill = viridis::viridis_pal(option = "magma", direction=-1)(length(Type)), # USE THE SAME COLOR PALETTE
horiz = FALSE,
cex = 0.6, # PROPER PARAMETER FOR TEXT SIZE
text.width = 0.7 # SET THE BOX WIDTH
)
Add the title manually:
title("Pie Chart of Primary Crime Types", line = -1)
Can't let a pie chart stand alone (and, now, a 3D one at that):
structure(list(cat = c("Arson", "Assault", "Battery", "Burglary",
"Criminal Damage", "Criminal Trespass", "Deceptive Practice",
"Homicide", "Kidnapping", "Motor Vehicle Theft", "Narcotocs",
"Offense Involving Children", "Other Offense", "Public Offense",
"Public Peace Violation", "Robbery", "Sex Crime", "Theft", "Weapons Violation"
), val = c(833, 30743, 91237, 29298, 57539, 14353, 17472, 640,
517, 23724, 55685, 3347, 30878, 3833, 3632, 18891, 9331, 103255,
4792), pct = c(0.001666, 0.061486, 0.182474, 0.058596, 0.115078,
0.028706, 0.034944, 0.00128, 0.001034, 0.047448, 0.11137, 0.006694,
0.061756, 0.007666, 0.007264, 0.037782, 0.018662, 0.20651, 0.009584
)), class = "data.frame", row.names = c(NA, -19L)) -> xdf
dplyr::arrange(xdf, pct) %>%
dplyr::mutate(cat = factor(cat, levels=cat)) %>%
dplyr::mutate(lab = sprintf("%s (%s)", scales::comma(val), scales::percent(pct))) %>%
ggplot(aes(pct, cat)) +
geom_segment(aes(xend=0, yend=cat), size=4, color = "#617a89") +
geom_label(
aes(label=lab), label.size = 0, hjust=0, nudge_x=0.001,
size = 3, family = hrbrthemes::font_rc, color = "#909495"
) +
hrbrthemes::scale_x_percent(expand=c(0,0.001), limits=c(0,0.25)) +
labs(x = NULL, y = NULL, title = "'Theft', 'Battery' & 'Criminal Damage' Account\nfor Half of Primary Recorded Crime Types") +
hrbrthemes::theme_ipsum_rc(grid="X") +
theme(axis.text.x = element_blank())
How I got xdf:
readLines(textConnection("ARSON ASSAULT BATTERY BURGLARY
833 30743 91237 29298
CRIMINAL_DAMAGE CRIMINAL_TRESPASS DECEPTIVE_PRACTICE HOMICIDE
57539 14353 17472 640
KIDNAPPING MOTOR_VEHICLE_THEFT NARCOTOCS OFFENSE_INVOLVING_CHILDREN
517 23724 55685 3347
OTHER_OFFENSE PUBLIC_OFFENSE PUBLIC_PEACE_VIOLATION ROBBERY
30878 3833 3632 18891
SEX_CRIME THEFT WEAPONS_VIOLATION
9331 103255 4792")) %>%
trimws() %>%
stri_split_regex("[[:space:]]+") -> x
do.call(rbind.data.frame, lapply(seq.int(1, length(x), 2), function(i) {
data.frame(
cat = stri_trans_totitle(gsub("_", " ", x[[i]])),
val = as.numeric(x[[i+1]]),
stringsAsFactors = FALSE
)
})) %>%
mutate(pct = val/sum(val)) -> xdf
I think this might have an easy answer - which I can't seem to find anywhere - so I'll forgo the reproducibility for the moment. I have a function designed to draw a ggplot2. I use mapply to pass it a few vectors of strings for the functions input parameters. The parameter of concern here is title. Which is fed a character vector with elements such as "this is a plot title".
Then the following code:
p <- ggplot(df, aes(x=date, y=value))
## plot the line
p <- p + geom_line()
## add plot title
p <- p + ggtitle(title)
actually works just fine and the plot title is "this is a plot title" as expected.
However if the title is long and I want to specify a point to wrap the title using \n it fails to work.
Precisely if I feed ggtitle an element of "this is a \n plot title". I get exactly that contained in the quotes, rather than wrapping the title at the \n. My suspicion is I need eval, or paste or get, but my formations of such a request have failed to achieve the desired results. I appreciate the help.
UPDATE:
I guess it must be the interaction with mapply. This should allow you to reproduce the problem.
create data.frame of strings as sample and assign it to fred.M.SA
structure(list(RegionalCoverage = c("National", "National", "National",
"National", "National", "National"), GeographicLevel = c("MSA",
"MSA", "MSA", "MSA", "MSA", "MSA"), Category = c("Workers", "Workers",
"Workers", "Workers", "Workers", "Workers"), Sector = c("Labor Market",
"Labor Market", "Labor Market", "Labor Market", "Labor Market",
"Labor Market"), Source2 = c("FRED", "FRED", "FRED", "FRED",
"FRED", "FRED"), Title = c("Unemployment Rate in La Crosse, WI-MN (MSA)",
"Trade, Transportation and Utilities Employment in La Crosse, WI-MN (MSA)",
"Professional and Business Services Employment in La Crosse, WI-MN (MSA)",
"Other Services Employment in La Crosse, WI-MN (MSA)", "Manufacturing Employment in La Crosse, WI-MN (MSA)",
"Leisure and Hospitality Employment \\n in La Crosse, WI-MN (MSA)"
), SeriesID = c("LACR155UR", "LACR155TRAD", "LACR155PBSV", "LACR155SRVO",
"LACR155MFG", "LACR155LEIH"), Units = c("%", "Thous. of Persons",
"Thous. of Persons", "Thous. of Persons", "Thous. of Persons",
"Thous. of Persons"), Freq = c("M", "M", "M", "M", "M", "M"),
Seas = c("SA", "SA", "SA", "SA", "SA", "SA"), OriginalSource = c("U.S. Department of Labor: Bureau of Labor Statistics",
"Federal Reserve Bank of St. Louis", "Federal Reserve Bank of St. Louis",
"Federal Reserve Bank of St. Louis", "Federal Reserve Bank of St. Louis",
"Federal Reserve Bank of St. Louis"), Method = c("ImportXML",
"ImportXML", "ImportXML", "ImportXML", "ImportXML", "ImportXML"
), LinktoSource = c("", "", "", "", "", ""), Link.to.Data.Spreadsheet.Name = c("",
"", "", "", "", ""), Link.to.Data.Storage = c("", "", "",
"", "", ""), Link.to.Data.Manipulation.File = c(NA, NA, NA,
NA, NA, NA), Link.to.Data.Manipulation.File.1 = c(NA, NA,
NA, NA, NA, NA)), .Names = c("RegionalCoverage", "GeographicLevel",
"Category", "Sector", "Source2", "Title", "SeriesID", "Units",
"Freq", "Seas", "OriginalSource", "Method", "LinktoSource", "Link.to.Data.Spreadsheet.Name",
"Link.to.Data.Storage", "Link.to.Data.Manipulation.File", "Link.to.Data.Manipulation.File.1"
), row.names = c(27L, 34L, 44L, 46L, 47L, 48L), class = "data.frame")
MakelineFred <- function(series, ylab="",xlab="", title="") {
require(ggplot2) # hadley's plotting framework
require(scales) # to adjust y axis scales
require(ggthemes) # extra themes including tufte
require(xts) # our favorite time series
require(gridExtra) # for adding a caption
require(timeDate) # for our prediction at the end
require(quantmod) #
# Get Data using quantmod
data <- getSymbols(series,src="FRED") #fred ignore from dates
# convert the string df to object df
data.xts <- get(data)
## convert data to data.frame
df <- data.frame(
date=as.Date(index(data.xts)),
value=as.numeric(data.xts))
p <- ggplot(df, aes(x=date, y=value))
## plot the line
p <- p + geom_line()
## add plot title
p <- p + ggtitle(title)
file <- paste("_",series,".png",sep="")
ggsave(file=file, plot=p, width=6, height=4)
finally here is the mapply call.
mapply(MakelineFred, series=fred.M.SA$SeriesID, title=fred.M.SA$Title)