In Hendriico/MOSLReports: MOSL's automated reports
\newpage
# Filtering each data set for the Trading Party and creating TEMP file for the rest of the loop --------------------------------------------------------------------------------------------------------------------------------------------------------------------
mps_list_pr <- c("MPS 1", "MPS 2", "MPS 3", "MPS 4", "MPS 7", "MPS 12", "MPS 15", "MPS 16", "MPS 17")
mps_data_temp <- mps_data %>%
filter(Trading.Party.ID == TRADING.PARTY) %>%
droplevels()
mps_list <- unique(mps_data_temp$MPS)
mps_data_melt_temp <- mps_data_melt %>%
filter(Trading.Party.ID == TRADING.PARTY) %>%
droplevels()
charges_graph_temp <- charges_graph %>%
filter(Trading.Party.ID == TRADING.PARTY)
charges_table_temp <- charges_table %>%
filter(Trading.Party.ID == TRADING.PARTY) %>%
select(Date, MPS, Charges) %>%
spread(MPS, Charges)
charges_table_temp$Total <- charges_table_temp %>%
select(-Date) %>%
rowSums(na.rm = TRUE)
iprp_status_temp <- iprp_status %>%
filter(Trading.Party.ID == TRADING.PARTY, Date == latest_period) %>%
mutate(Date = format(Date, "%Y-%m")) %>%
select(-Trading.Party.ID)
if (nrow(iprp_status_temp) > 0) {
IPRP_list <- iprp_status_temp$MPS %>%
droplevels()
IPRP_plans_melt_temp <- IPRP_plans_melt %>%
filter(Trading.Party.ID == TRADING.PARTY) %>%
droplevels()
}
tracking_pfm_mpsperf_temp <- tracking_pfm_mpsperf %>%
filter(Trading.Party.ID == TRADING.PARTY) %>%
select(-Trading.Party.ID)
tracking_pfm_mile_temp <- tracking_pfm_mile %>%
filter(Trading.Party.ID == TRADING.PARTY) %>%
select(-Trading.Party.ID)
tracking_performance_temp <- tracking_performance %>%
filter(Trading.Party.ID == TRADING.PARTY) %>%
select(-Trading.Party.ID)
tracking_milestone_temp <- tracking_milestone %>%
filter(Trading.Party.ID == TRADING.PARTY) %>%
select(-Trading.Party.ID)
tracking_watch_temp <- tracking_watch %>%
filter(Trading.Party.ID == TRADING.PARTY)
mps_summary_mean_temp <- mps_summary %>%
select(Date, MPS, MPS_Mean) %>%
filter(MPS %in% (mps_list)) %>%
spread(MPS, MPS_Mean)
mps_summary_median_temp <- mps_summary %>%
select(Date, MPS, MPS_Median) %>%
filter(MPS %in% (mps_list)) %>%
spread(MPS, MPS_Median)
mps_summary_tasks_temp <- mps_summary %>%
select(Date, MPS, TotalTaskVolume) %>%
filter(MPS %in% (mps_list)) %>%
spread(MPS, TotalTaskVolume)
ops_data_temp <- ops_data %>%
filter(Trading.Party.ID == TRADING.PARTY)
if (nrow(ops_data_temp) > 0) {
ops_list <- unique(ops_data_temp$OPS)
ops_summary_mean_temp <- ops_summary %>%
select(Date, OPS, OPS_Mean) %>%
filter(OPS %in% (ops_list)) %>%
spread(Date, OPS_Mean)
ops_summary_median_temp <- ops_summary %>%
select(Date, OPS, OPS_Median) %>%
filter(OPS %in% (ops_list)) %>%
spread(Date, OPS_Median)
ops_summary_tasks_temp <- ops_summary %>%
select(Date, OPS, TotalTaskVolume) %>%
filter(OPS %in% (ops_list)) %>%
spread(Date, TotalTaskVolume)
ops_data_melt_temp <- ops_data_melt %>%
filter(Trading.Party.ID == TRADING.PARTY) %>%
droplevels()
}
Trading Party MPS Performance
Charges
# Creating table of charges by MPS --------------------------------------------------------------------------------------------------------------------------------------------------------------------
kable (charges_table_temp,
format = "latex",
caption = "Breakdown of Charges by MPS",
booktabs = TRUE,
linesep = "",
format.args = list(big.mark = ",")
) %>%
kable_styling(
latex_options = c("repeat_header", "hold_position",
"striped", "scale_down",
position = "center", full_width = TRUE)) %>%
row_spec(0, bold = TRUE)
# Creating two charges graphs and combines as single plot --------------------------------------------------------------------------------------------------------------------------------------------------------------------
g1 <- ggplot(charges_graph_temp, aes(x = Date, y = Charges)) +
geom_bar(stat = "identity") +
theme_stata(base_size = 11) +
scale_y_continuous(
name = "Charges",
labels = scales::comma,
breaks = pretty_breaks(4)
) +
ggtitle("Total Charges by Month")
g2 <- ggplot(
charges_graph_temp,
aes(
x = Date,
y = Charges,
fill = MPS
)
) +
geom_bar(
position = "fill",
stat = "identity"
) +
theme_stata(base_size = 11) +
scale_y_continuous(
name = "Proportion of Monthly Charge",
breaks = c(0, 0.25, 0.5, 0.75, 1)
) +
theme(legend.title = element_blank()) +
ggtitle("Breakdown of Charges by MPS")
gg <- gridExtra::arrangeGrob(g1, g2, nrow = 2, ncol = 1)
plot(gg)
\newpage
MPS Performance Flags
r TRADING.PARTY has had r nrow(tracking_performance_temp) performance flag(s).
if (nrow(tracking_performance_temp) > 0) {
kable(tracking_performance_temp,
format = "latex",
caption = "Flags for below peer performance",
col.names = c("Date", "MPS", "Action", "Rationale"),
booktabs = TRUE,
linesep = "",
format.args = list(big.mark = ",")
) %>%
kable_styling(
latex_options = c(
"repeat_header",
"hold_position",
"striped",
position = "center",
full_width = FALSE)
) %>%
column_spec(4, width = "8.5cm") %>%
row_spec(0, bold = TRUE)
}
Where an Action is recorded as "Watch", the performance issue will be added to MOSL's watch-list of performance issues. Any performance issue(s) on the watch-list could be closely monitored over a number of months. If the issue is not resolved then it could be escalated to an IPRP. r TRADING.PARTY currently has r nrow(tracking_watch_temp) performance issues on Watch.
if (nrow(tracking_watch_temp) > 0) {
kable(tracking_watch_temp,
format = "latex",
caption = "Performance issues currently on Watch",
col.names = c("Trading Party", "MPS"),
booktabs = TRUE,
longtable = TRUE,
linesep = "",
format.args = list(big.mark = ",")
) %>%
kable_styling(
latex_options = c(
"repeat_header",
"hold_position",
"striped",
position = "center",
full_width = FALSE)
) %>%
row_spec(0, bold = TRUE)
}
Below is a summary (where applicable) of the commentary that MOSL has received, via the Portfolio Manager, regarding any watch-list items or flagged performance issues:
if (nrow(tracking_pfm_mpsperf_temp) > 0) {
kable(tracking_pfm_mpsperf_temp,
format = "latex",
caption = "PFM Commentary",
col.names = c("Date", "MPS", "Commentary"),
booktabs = TRUE,
longtable = TRUE,
linesep = "",
format.args = list(big.mark = ",")
) %>%
kable_styling(
latex_options = c(
"repeat_header",
"hold_position",
"striped",
position = "center",
full_width = FALSE)
) %>%
column_spec(3, width = "10cm") %>%
row_spec(0, bold = TRUE)
}
Trading Party Performance Graphs (MPS)
MOSL uses performance graphs as a monitoring tool to identify issues. The performance graphs for r TRADING.PARTY are shown below.
labels <- c("TP On-Time Tasks (RHS)", "Market Mean (RHS)", "Market Median (RHS)", "TP Task Share (RHS)")
plist = lapply(split(mps_data_melt_temp, mps_data_melt_temp$MPS), function(z) {
data <- z
plot <- ggplot(data) +
geom_bar(
aes(
x = data$Date,
y = data$TaskVolume,
fill="Task Volume (LHS)"
),
stat = "identity",
position = "dodge",
inherit.aes = FALSE
) +
geom_line(
aes(
x = data$Date,
y = data$value * max(data$TaskVolume),
colour = data$variable,
linetype = data$variable,
size = data$variable
)
) +
scale_y_continuous(
breaks = pretty_breaks(4),
sec.axis =
sec_axis(~. / max(data$TaskVolume), name = "Proportion")
) +
scale_fill_manual(NULL, values = "azure3", na.value = "red") +
scale_size_manual(values = c(1, 0.5, 0.5, 0.5), na.value = "1", labels = labels) +
scale_linetype_manual(values = c(1, 2, 1, 3), na.value = "1", labels = labels) +
scale_colour_manual(values = c("darkorange", "azure4", "dodgerblue4", "grey3"),
na.value = "red", labels = labels) +
ylab("Volume of tasks") + xlab("Date") +
theme(legend.title = element_blank(), legend.position = "right") +
ggtitle(paste(data$Trading.Party.ID, " (", data$MPS, ")", sep=""))
}
)
gridExtra::marrangeGrob(plist,top=NULL,nrow=1,ncol=1)
\newpage
MPS Performance Rectification
r if (nrow(iprp_status_temp) > 0) { "## IPRP Status Summary" }
r TRADING.PARTY currently has r nrow(iprp_status_temp) active IPRP(s).
if(nrow(iprp_status_temp) > 0){
kable(
iprp_status_temp,
format = "latex",
caption = "Current status of IPRP(s)",
col.names = c(
"Date",
"MPS",
"Batch",
"Actual Perf.",
"Planned Perf.",
"Status"),
longtable = FALSE,
booktabs = TRUE,
linesep = ""
) %>%
kable_styling(
latex_options =
c(
"repeat_header",
"hold_position",
"striped",
position= "center",
full_width = TRUE
)
) %>%
row_spec(0, bold = TRUE)
}
r if(nrow(tracking_milestone_temp) > 0) { paste("Below is a table summarising details of the IPRP Milestone flags for ", TRADING.PARTY, ".", sep = "") }
if(nrow(tracking_milestone_temp) > 0) {
kable(
tracking_milestone_temp,
format = "latex",
caption = "IPRPs flagged as below milestone",
col.names = c(
"Date",
"MPS",
"Batch",
"Action",
"Rationale"),
longtable = TRUE,
booktabs = TRUE,
linesep = ""
) %>%
kable_styling(
latex_options =
c(
"repeat_header",
"hold_position",
"striped",
position = "center",
full_width = FALSE
)
) %>%
column_spec(5, width = "7cm") %>%
row_spec(0, bold = TRUE)
}
r if (nrow(tracking_pfm_mile_temp) > 0) { paste("Below is a summary of the commentary that MOSL has received via the Portfolio Manager regarding the milestone performance flags:") }
if (nrow(tracking_pfm_mile_temp) > 0) {
kable(tracking_pfm_mile_temp,
format = "latex",
caption = "PFM Commentary",
col.names = c("Date", "MPS", "Commentary"),
booktabs = TRUE,
longtable = TRUE,
linesep = "",
format.args = list(big.mark = ",")
) %>%
kable_styling(
latex_options = c(
"repeat_header",
"hold_position",
"striped",
position = "center",
full_width = FALSE)
) %>%
column_spec(3, width = "10cm") %>%
row_spec(0, bold = TRUE)
}
\newpage
r if (nrow(iprp_status_temp) > 0) { "## IPRP Graphs" }
r if (nrow(iprp_status_temp) > 0) { paste("The graphs below depict the performance of each IPRP against its planned milestones.") }
if (nrow(iprp_status_temp) > 0) {
##producing the graphs as list then using marrangeGrob
iprp_labels <- c("Task Completion (RHS)", "Mean (RHS)", "Median (RHS)", "Task Share (RHS)", "Planned Perf (RHS)")
for (v in IPRP_list) {
data <- IPRP_plans_melt_temp %>%
filter(MPS == v)
plot <- ggplot(data) +
geom_bar(
aes(
x = data$Date,
y = data$TaskVolume,
fill = "Task Volume (LHS)"
),
stat = "identity",
position = "dodge",
inherit.aes = FALSE
) +
geom_line(
aes(
x = data$Date,
y = data$value * max(data$TaskVolume),
colour = data$variable,
linetype = data$variable,
size = data$variable
)
) +
geom_point(
aes(
x = data$Date,
y = data$value * max(data$TaskVolume),
shape = data$variable,
alpha = data$variable
)
) +
scale_y_continuous(
breaks = pretty_breaks(4),
sec.axis =
sec_axis(~. / max(data$TaskVolume), name = "Proportion")
) +
scale_fill_manual(NULL, values = "azure3", na.value = "red") +
scale_size_manual(values = c(1,0.5,0.5,0.5,1), na.value = "1", labels = iprp_labels) +
scale_linetype_manual(values = c(1,2,1,3,1), na.value = "1", labels = iprp_labels) +
scale_colour_manual(
values =
c("darkorange", "azure4", "dodgerblue4","grey3","red"),
na.value = "red",
labels = iprp_labels
) +
scale_shape_manual(values = c(0,0,0,0,1), na.value = 0,labels = iprp_labels) +
scale_alpha_manual(values = c(0,0,0,0,1), na.value = 0, labels = iprp_labels) +
ylab("Volume of tasks") + xlab("Date") +
theme(legend.title = element_blank(), legend.position = "right") +
ggtitle(
paste(
"Batch ",
max(as.numeric(data$Batch), na.rm = TRUE),
": ",
data$Trading.Party.ID,
" (",
data$MPS,
")",
sep="")
)
print(plot)
}
}
\newpage
MPS Market Aggregates
kable(mps_summary_mean_temp,
format = "latex",
caption = "Mean peer performance",
booktabs = TRUE,
linesep = "",
digits = 1,
format.args = list(decimal.mark = ".", big.mark = ",")) %>%
kable_styling(
latex_options =
c(
"repeat_header",
"hold_position",
"striped",
position = "center",
full_width = TRUE,
"scale_down"
)
) %>%
row_spec(0, bold = TRUE)
kable(mps_summary_median_temp,
format = "latex",
caption = "Median peer performance",
booktabs = TRUE,
linesep = "",
digits = 1,
format.args = list(decimal.mark = ".", big.mark = ",")) %>%
kable_styling(
latex_options =
c(
"repeat_header",
"hold_position",
"striped",
position = "center",
full_width = TRUE,
"scale_down"
)
) %>%
row_spec(0, bold = TRUE)
kable(mps_summary_tasks_temp,
format = "latex",
caption = "Aggregate task volumes",
booktabs = TRUE,
linesep = "",
format.args = list(big.mark = ",")) %>%
kable_styling(
latex_options =
c(
"repeat_header",
"hold_position",
"striped",
position = "center",
full_width = TRUE,
"scale_down"
)
) %>%
row_spec(0, bold = TRUE)
\newpage
r if (nrow(ops_data_temp) > 0) { "# Trading Party OPS Performance" }
r if (nrow(ops_data_temp) > 0) { "## Trading Party Performance Graphs (OPS)" }
r if (nrow(ops_data_temp) > 0) { paste("MOSL uses performance graphs as a monitoring tool to identify issues. The performance graphs for ", TRADING.PARTY, " are shown below.", sep = "") }
if (nrow(ops_data_temp) > 0) {
labels <- c("TP On-Time Tasks (RHS)", "Market Mean (RHS)", "Market Median (RHS)", "TP Task Share (RHS)")
oplist = lapply(split(ops_data_melt_temp, ops_data_melt_temp$key), function(v) {
data <- v
plot <- ggplot(data) +
geom_bar(
aes(
x = data$Date,
y = data$TaskVolume,
fill="Task Volume (LHS)"
),
stat = "identity",
position = "dodge",
inherit.aes = FALSE
) +
geom_line(
aes(
x = data$Date,
y = data$value * max(data$TaskVolume),
colour = data$variable,
linetype = data$variable,
size = data$variable
)
) +
scale_y_continuous(
breaks = pretty_breaks(4),
sec.axis =
sec_axis(~. / max(data$TaskVolume), name = "Proportion")
) +
scale_fill_manual(NULL, values = "azure3", na.value = "red") +
scale_size_manual(values = c(1, 0.5, 0.5, 0.5), na.value = "1", labels = labels) +
scale_linetype_manual(values = c(1, 2, 1, 3), na.value = "1", labels = labels) +
scale_colour_manual(
values = c("darkorange", "azure4", "dodgerblue4", "grey3"),
na.value = "red", labels = labels) +
ylab("Volume of tasks") + xlab("Date") +
theme(legend.title = element_blank(), legend.position = "right") +
ggtitle(paste(data$Trading.Party.ID, " (", data$OPS, ")", sep=""))
}
)
gridExtra::marrangeGrob(oplist,top=NULL,nrow=1,ncol=1)
}
\newpage
r if(nrow(ops_data_temp) > 0) { "# OPS Market Aggregates" }
if (nrow(ops_data_temp) > 0) {
kable(ops_summary_mean_temp,
format = "latex",
caption = "Mean peer performance",
booktabs = TRUE,
linesep = "",
digits = 1,
format.args = list(decimal.mark = ".", big.mark = ",")) %>%
kable_styling(
latex_options =
c(
"repeat_header",
"hold_position",
"striped",
position = "center",
full_width = TRUE,
"scale_down"
)
) %>%
row_spec(0, bold = TRUE)
}
if (nrow(ops_data_temp) > 0) {
kable(ops_summary_median_temp,
format = "latex",
caption = "Median peer performance",
booktabs = TRUE,
linesep = "",
digits = 1,
format.args = list(decimal.mark = ".", big.mark = ",")) %>%
kable_styling(
latex_options =
c(
"repeat_header",
"hold_position",
"striped",
position = "center",
full_width = TRUE,
"scale_down"
)
) %>%
row_spec(0, bold = TRUE)
}
if (nrow(ops_data_temp) > 0) {
kable(ops_summary_tasks_temp,
format = "latex",
caption = "Aggregate task volumes",
booktabs = TRUE,
linesep = "",
format.args = list(big.mark = ",")) %>%
kable_styling(
latex_options =
c(
"repeat_header",
"hold_position",
"striped",
position = "center",
full_width = TRUE,
"scale_down"
)
) %>%
row_spec(0, bold = TRUE)
}
Appendix
Performance Criteria
A Trading Party's MPS performance will be flagged when the ratio of on-time task completion to total tasks completed for that MPS falls below the peer mean and peer median level for three consecutive months. "Peer mean" and "peer median" refer, respectively, to the mean and median of all on-time task ratios for every Trading Party in the market. The following MPS are currently subject to this criteria: r paste(mps_list_pr, sep = ", ").
When evaluating these performance flags, MOSL takes into account other factors, including: performance relative to comparable peers; number of tasks relative to size; and other important Trading Party activites, such as data improvement activity and significant operational changes.
Persistently poor performance could lead to the issue being escalated to MOSL's Performance Resolution process through an Initial Performance Rectification Plan (IPRP). Failure to improve over time at this stage could lead to the issue being further escalated to a Performance Rectification Plan (PRP) overseen by MPC and/or Panel.
Hendriico/MOSLReports documentation built on Dec. 15, 2019, 9:41 p.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
\newpage
# Filtering each data set for the Trading Party and creating TEMP file for the rest of the loop -------------------------------------------------------------------------------------------------------------------------------------------------------------------- mps_list_pr <- c("MPS 1", "MPS 2", "MPS 3", "MPS 4", "MPS 7", "MPS 12", "MPS 15", "MPS 16", "MPS 17") mps_data_temp <- mps_data %>% filter(Trading.Party.ID == TRADING.PARTY) %>% droplevels() mps_list <- unique(mps_data_temp$MPS) mps_data_melt_temp <- mps_data_melt %>% filter(Trading.Party.ID == TRADING.PARTY) %>% droplevels() charges_graph_temp <- charges_graph %>% filter(Trading.Party.ID == TRADING.PARTY) charges_table_temp <- charges_table %>% filter(Trading.Party.ID == TRADING.PARTY) %>% select(Date, MPS, Charges) %>% spread(MPS, Charges) charges_table_temp$Total <- charges_table_temp %>% select(-Date) %>% rowSums(na.rm = TRUE) iprp_status_temp <- iprp_status %>% filter(Trading.Party.ID == TRADING.PARTY, Date == latest_period) %>% mutate(Date = format(Date, "%Y-%m")) %>% select(-Trading.Party.ID) if (nrow(iprp_status_temp) > 0) { IPRP_list <- iprp_status_temp$MPS %>% droplevels() IPRP_plans_melt_temp <- IPRP_plans_melt %>% filter(Trading.Party.ID == TRADING.PARTY) %>% droplevels() } tracking_pfm_mpsperf_temp <- tracking_pfm_mpsperf %>% filter(Trading.Party.ID == TRADING.PARTY) %>% select(-Trading.Party.ID) tracking_pfm_mile_temp <- tracking_pfm_mile %>% filter(Trading.Party.ID == TRADING.PARTY) %>% select(-Trading.Party.ID) tracking_performance_temp <- tracking_performance %>% filter(Trading.Party.ID == TRADING.PARTY) %>% select(-Trading.Party.ID) tracking_milestone_temp <- tracking_milestone %>% filter(Trading.Party.ID == TRADING.PARTY) %>% select(-Trading.Party.ID) tracking_watch_temp <- tracking_watch %>% filter(Trading.Party.ID == TRADING.PARTY) mps_summary_mean_temp <- mps_summary %>% select(Date, MPS, MPS_Mean) %>% filter(MPS %in% (mps_list)) %>% spread(MPS, MPS_Mean) mps_summary_median_temp <- mps_summary %>% select(Date, MPS, MPS_Median) %>% filter(MPS %in% (mps_list)) %>% spread(MPS, MPS_Median) mps_summary_tasks_temp <- mps_summary %>% select(Date, MPS, TotalTaskVolume) %>% filter(MPS %in% (mps_list)) %>% spread(MPS, TotalTaskVolume) ops_data_temp <- ops_data %>% filter(Trading.Party.ID == TRADING.PARTY) if (nrow(ops_data_temp) > 0) { ops_list <- unique(ops_data_temp$OPS) ops_summary_mean_temp <- ops_summary %>% select(Date, OPS, OPS_Mean) %>% filter(OPS %in% (ops_list)) %>% spread(Date, OPS_Mean) ops_summary_median_temp <- ops_summary %>% select(Date, OPS, OPS_Median) %>% filter(OPS %in% (ops_list)) %>% spread(Date, OPS_Median) ops_summary_tasks_temp <- ops_summary %>% select(Date, OPS, TotalTaskVolume) %>% filter(OPS %in% (ops_list)) %>% spread(Date, TotalTaskVolume) ops_data_melt_temp <- ops_data_melt %>% filter(Trading.Party.ID == TRADING.PARTY) %>% droplevels() }
Trading Party MPS Performance
Charges
# Creating table of charges by MPS -------------------------------------------------------------------------------------------------------------------------------------------------------------------- kable (charges_table_temp, format = "latex", caption = "Breakdown of Charges by MPS", booktabs = TRUE, linesep = "", format.args = list(big.mark = ",") ) %>% kable_styling( latex_options = c("repeat_header", "hold_position", "striped", "scale_down", position = "center", full_width = TRUE)) %>% row_spec(0, bold = TRUE) # Creating two charges graphs and combines as single plot -------------------------------------------------------------------------------------------------------------------------------------------------------------------- g1 <- ggplot(charges_graph_temp, aes(x = Date, y = Charges)) + geom_bar(stat = "identity") + theme_stata(base_size = 11) + scale_y_continuous( name = "Charges", labels = scales::comma, breaks = pretty_breaks(4) ) + ggtitle("Total Charges by Month") g2 <- ggplot( charges_graph_temp, aes( x = Date, y = Charges, fill = MPS ) ) + geom_bar( position = "fill", stat = "identity" ) + theme_stata(base_size = 11) + scale_y_continuous( name = "Proportion of Monthly Charge", breaks = c(0, 0.25, 0.5, 0.75, 1) ) + theme(legend.title = element_blank()) + ggtitle("Breakdown of Charges by MPS") gg <- gridExtra::arrangeGrob(g1, g2, nrow = 2, ncol = 1) plot(gg)
\newpage
MPS Performance Flags
r TRADING.PARTY has had r nrow(tracking_performance_temp) performance flag(s).
if (nrow(tracking_performance_temp) > 0) { kable(tracking_performance_temp, format = "latex", caption = "Flags for below peer performance", col.names = c("Date", "MPS", "Action", "Rationale"), booktabs = TRUE, linesep = "", format.args = list(big.mark = ",") ) %>% kable_styling( latex_options = c( "repeat_header", "hold_position", "striped", position = "center", full_width = FALSE) ) %>% column_spec(4, width = "8.5cm") %>% row_spec(0, bold = TRUE) }
Where an Action is recorded as "Watch", the performance issue will be added to MOSL's watch-list of performance issues. Any performance issue(s) on the watch-list could be closely monitored over a number of months. If the issue is not resolved then it could be escalated to an IPRP. r TRADING.PARTY currently has r nrow(tracking_watch_temp) performance issues on Watch.
if (nrow(tracking_watch_temp) > 0) { kable(tracking_watch_temp, format = "latex", caption = "Performance issues currently on Watch", col.names = c("Trading Party", "MPS"), booktabs = TRUE, longtable = TRUE, linesep = "", format.args = list(big.mark = ",") ) %>% kable_styling( latex_options = c( "repeat_header", "hold_position", "striped", position = "center", full_width = FALSE) ) %>% row_spec(0, bold = TRUE) }
Below is a summary (where applicable) of the commentary that MOSL has received, via the Portfolio Manager, regarding any watch-list items or flagged performance issues:
if (nrow(tracking_pfm_mpsperf_temp) > 0) { kable(tracking_pfm_mpsperf_temp, format = "latex", caption = "PFM Commentary", col.names = c("Date", "MPS", "Commentary"), booktabs = TRUE, longtable = TRUE, linesep = "", format.args = list(big.mark = ",") ) %>% kable_styling( latex_options = c( "repeat_header", "hold_position", "striped", position = "center", full_width = FALSE) ) %>% column_spec(3, width = "10cm") %>% row_spec(0, bold = TRUE) }
Trading Party Performance Graphs (MPS)
MOSL uses performance graphs as a monitoring tool to identify issues. The performance graphs for r TRADING.PARTY are shown below.
labels <- c("TP On-Time Tasks (RHS)", "Market Mean (RHS)", "Market Median (RHS)", "TP Task Share (RHS)") plist = lapply(split(mps_data_melt_temp, mps_data_melt_temp$MPS), function(z) { data <- z plot <- ggplot(data) + geom_bar( aes( x = data$Date, y = data$TaskVolume, fill="Task Volume (LHS)" ), stat = "identity", position = "dodge", inherit.aes = FALSE ) + geom_line( aes( x = data$Date, y = data$value * max(data$TaskVolume), colour = data$variable, linetype = data$variable, size = data$variable ) ) + scale_y_continuous( breaks = pretty_breaks(4), sec.axis = sec_axis(~. / max(data$TaskVolume), name = "Proportion") ) + scale_fill_manual(NULL, values = "azure3", na.value = "red") + scale_size_manual(values = c(1, 0.5, 0.5, 0.5), na.value = "1", labels = labels) + scale_linetype_manual(values = c(1, 2, 1, 3), na.value = "1", labels = labels) + scale_colour_manual(values = c("darkorange", "azure4", "dodgerblue4", "grey3"), na.value = "red", labels = labels) + ylab("Volume of tasks") + xlab("Date") + theme(legend.title = element_blank(), legend.position = "right") + ggtitle(paste(data$Trading.Party.ID, " (", data$MPS, ")", sep="")) } ) gridExtra::marrangeGrob(plist,top=NULL,nrow=1,ncol=1)
\newpage
MPS Performance Rectification
r if (nrow(iprp_status_temp) > 0) { "## IPRP Status Summary" }
r TRADING.PARTY currently has r nrow(iprp_status_temp) active IPRP(s).
if(nrow(iprp_status_temp) > 0){ kable( iprp_status_temp, format = "latex", caption = "Current status of IPRP(s)", col.names = c( "Date", "MPS", "Batch", "Actual Perf.", "Planned Perf.", "Status"), longtable = FALSE, booktabs = TRUE, linesep = "" ) %>% kable_styling( latex_options = c( "repeat_header", "hold_position", "striped", position= "center", full_width = TRUE ) ) %>% row_spec(0, bold = TRUE) }
r if(nrow(tracking_milestone_temp) > 0) { paste("Below is a table summarising details of the IPRP Milestone flags for ", TRADING.PARTY, ".", sep = "") }
if(nrow(tracking_milestone_temp) > 0) { kable( tracking_milestone_temp, format = "latex", caption = "IPRPs flagged as below milestone", col.names = c( "Date", "MPS", "Batch", "Action", "Rationale"), longtable = TRUE, booktabs = TRUE, linesep = "" ) %>% kable_styling( latex_options = c( "repeat_header", "hold_position", "striped", position = "center", full_width = FALSE ) ) %>% column_spec(5, width = "7cm") %>% row_spec(0, bold = TRUE) }
r if (nrow(tracking_pfm_mile_temp) > 0) { paste("Below is a summary of the commentary that MOSL has received via the Portfolio Manager regarding the milestone performance flags:") }
if (nrow(tracking_pfm_mile_temp) > 0) { kable(tracking_pfm_mile_temp, format = "latex", caption = "PFM Commentary", col.names = c("Date", "MPS", "Commentary"), booktabs = TRUE, longtable = TRUE, linesep = "", format.args = list(big.mark = ",") ) %>% kable_styling( latex_options = c( "repeat_header", "hold_position", "striped", position = "center", full_width = FALSE) ) %>% column_spec(3, width = "10cm") %>% row_spec(0, bold = TRUE) }
\newpage
r if (nrow(iprp_status_temp) > 0) { "## IPRP Graphs" }
r if (nrow(iprp_status_temp) > 0) { paste("The graphs below depict the performance of each IPRP against its planned milestones.") }
if (nrow(iprp_status_temp) > 0) { ##producing the graphs as list then using marrangeGrob iprp_labels <- c("Task Completion (RHS)", "Mean (RHS)", "Median (RHS)", "Task Share (RHS)", "Planned Perf (RHS)") for (v in IPRP_list) { data <- IPRP_plans_melt_temp %>% filter(MPS == v) plot <- ggplot(data) + geom_bar( aes( x = data$Date, y = data$TaskVolume, fill = "Task Volume (LHS)" ), stat = "identity", position = "dodge", inherit.aes = FALSE ) + geom_line( aes( x = data$Date, y = data$value * max(data$TaskVolume), colour = data$variable, linetype = data$variable, size = data$variable ) ) + geom_point( aes( x = data$Date, y = data$value * max(data$TaskVolume), shape = data$variable, alpha = data$variable ) ) + scale_y_continuous( breaks = pretty_breaks(4), sec.axis = sec_axis(~. / max(data$TaskVolume), name = "Proportion") ) + scale_fill_manual(NULL, values = "azure3", na.value = "red") + scale_size_manual(values = c(1,0.5,0.5,0.5,1), na.value = "1", labels = iprp_labels) + scale_linetype_manual(values = c(1,2,1,3,1), na.value = "1", labels = iprp_labels) + scale_colour_manual( values = c("darkorange", "azure4", "dodgerblue4","grey3","red"), na.value = "red", labels = iprp_labels ) + scale_shape_manual(values = c(0,0,0,0,1), na.value = 0,labels = iprp_labels) + scale_alpha_manual(values = c(0,0,0,0,1), na.value = 0, labels = iprp_labels) + ylab("Volume of tasks") + xlab("Date") + theme(legend.title = element_blank(), legend.position = "right") + ggtitle( paste( "Batch ", max(as.numeric(data$Batch), na.rm = TRUE), ": ", data$Trading.Party.ID, " (", data$MPS, ")", sep="") ) print(plot) } }
\newpage
MPS Market Aggregates
kable(mps_summary_mean_temp, format = "latex", caption = "Mean peer performance", booktabs = TRUE, linesep = "", digits = 1, format.args = list(decimal.mark = ".", big.mark = ",")) %>% kable_styling( latex_options = c( "repeat_header", "hold_position", "striped", position = "center", full_width = TRUE, "scale_down" ) ) %>% row_spec(0, bold = TRUE)
kable(mps_summary_median_temp, format = "latex", caption = "Median peer performance", booktabs = TRUE, linesep = "", digits = 1, format.args = list(decimal.mark = ".", big.mark = ",")) %>% kable_styling( latex_options = c( "repeat_header", "hold_position", "striped", position = "center", full_width = TRUE, "scale_down" ) ) %>% row_spec(0, bold = TRUE)
kable(mps_summary_tasks_temp, format = "latex", caption = "Aggregate task volumes", booktabs = TRUE, linesep = "", format.args = list(big.mark = ",")) %>% kable_styling( latex_options = c( "repeat_header", "hold_position", "striped", position = "center", full_width = TRUE, "scale_down" ) ) %>% row_spec(0, bold = TRUE)
\newpage
r if (nrow(ops_data_temp) > 0) { "# Trading Party OPS Performance" }
r if (nrow(ops_data_temp) > 0) { "## Trading Party Performance Graphs (OPS)" }
r if (nrow(ops_data_temp) > 0) { paste("MOSL uses performance graphs as a monitoring tool to identify issues. The performance graphs for ", TRADING.PARTY, " are shown below.", sep = "") }
if (nrow(ops_data_temp) > 0) { labels <- c("TP On-Time Tasks (RHS)", "Market Mean (RHS)", "Market Median (RHS)", "TP Task Share (RHS)") oplist = lapply(split(ops_data_melt_temp, ops_data_melt_temp$key), function(v) { data <- v plot <- ggplot(data) + geom_bar( aes( x = data$Date, y = data$TaskVolume, fill="Task Volume (LHS)" ), stat = "identity", position = "dodge", inherit.aes = FALSE ) + geom_line( aes( x = data$Date, y = data$value * max(data$TaskVolume), colour = data$variable, linetype = data$variable, size = data$variable ) ) + scale_y_continuous( breaks = pretty_breaks(4), sec.axis = sec_axis(~. / max(data$TaskVolume), name = "Proportion") ) + scale_fill_manual(NULL, values = "azure3", na.value = "red") + scale_size_manual(values = c(1, 0.5, 0.5, 0.5), na.value = "1", labels = labels) + scale_linetype_manual(values = c(1, 2, 1, 3), na.value = "1", labels = labels) + scale_colour_manual( values = c("darkorange", "azure4", "dodgerblue4", "grey3"), na.value = "red", labels = labels) + ylab("Volume of tasks") + xlab("Date") + theme(legend.title = element_blank(), legend.position = "right") + ggtitle(paste(data$Trading.Party.ID, " (", data$OPS, ")", sep="")) } ) gridExtra::marrangeGrob(oplist,top=NULL,nrow=1,ncol=1) }
\newpage
r if(nrow(ops_data_temp) > 0) { "# OPS Market Aggregates" }
if (nrow(ops_data_temp) > 0) { kable(ops_summary_mean_temp, format = "latex", caption = "Mean peer performance", booktabs = TRUE, linesep = "", digits = 1, format.args = list(decimal.mark = ".", big.mark = ",")) %>% kable_styling( latex_options = c( "repeat_header", "hold_position", "striped", position = "center", full_width = TRUE, "scale_down" ) ) %>% row_spec(0, bold = TRUE) }
if (nrow(ops_data_temp) > 0) { kable(ops_summary_median_temp, format = "latex", caption = "Median peer performance", booktabs = TRUE, linesep = "", digits = 1, format.args = list(decimal.mark = ".", big.mark = ",")) %>% kable_styling( latex_options = c( "repeat_header", "hold_position", "striped", position = "center", full_width = TRUE, "scale_down" ) ) %>% row_spec(0, bold = TRUE) }
if (nrow(ops_data_temp) > 0) { kable(ops_summary_tasks_temp, format = "latex", caption = "Aggregate task volumes", booktabs = TRUE, linesep = "", format.args = list(big.mark = ",")) %>% kable_styling( latex_options = c( "repeat_header", "hold_position", "striped", position = "center", full_width = TRUE, "scale_down" ) ) %>% row_spec(0, bold = TRUE) }
Appendix
Performance Criteria
A Trading Party's MPS performance will be flagged when the ratio of on-time task completion to total tasks completed for that MPS falls below the peer mean and peer median level for three consecutive months. "Peer mean" and "peer median" refer, respectively, to the mean and median of all on-time task ratios for every Trading Party in the market. The following MPS are currently subject to this criteria: r paste(mps_list_pr, sep = ", ").
When evaluating these performance flags, MOSL takes into account other factors, including: performance relative to comparable peers; number of tasks relative to size; and other important Trading Party activites, such as data improvement activity and significant operational changes.
Persistently poor performance could lead to the issue being escalated to MOSL's Performance Resolution process through an Initial Performance Rectification Plan (IPRP). Failure to improve over time at this stage could lead to the issue being further escalated to a Performance Rectification Plan (PRP) overseen by MPC and/or Panel.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.