Skip to content

Commit

Permalink
Merge pull request #111 from AgrDataSci/devel
Browse files Browse the repository at this point in the history 
Devel
  • Loading branch information
@kauedesousa
kauedesousa authored Jun 2, 2023
2 parents 65a9f95 + e210650 commit 5cad87d
Show file tree
Hide file tree
Showing 8 changed files with 156 additions and 75 deletions.
2 changes: 2 additions & 0 deletions modules/00_check_packages.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -12,4 +12,6 @@ pkg <- c('caret', 'climatrends', 'ClimMobTools', 'ggparty', 'ggplot2', 'gosset',

install.packages(pkg)

install.packages("ggchicklet", repos = "https://cinc.rud.is")

webshot::install_phantomjs(force = TRUE)
17 changes: 3 additions & 14 deletions modules/01_functions.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -33,25 +33,14 @@ library("gridExtra")
library("caret")
library("janitor")
library("lubridate")
library("ggchicklet")

#'Get colour pallet
#' @param x an integer
#' @examples
#' col_pallet(3)
col_pallet = function(x, ...) {

p = c('#d73027','#4575b4', '#f46d43','#74add1',
'#fdae61','#abd9e9', '#fee090', '#762a83',
'#a6dba0','#9970ab','#5aae61', '#c2a5cf',
'#1b7837','#ffffe5','#fff7bc','#fee391',
'#fec44f','#fe9929','#ec7014','#cc4c02',
'#993404','#662506')

v = p[1:x]

return(v)

}
col_pallet = colorRampPalette(c('#ccece6','#99d8c9','#66c2a4','#41ae76',
'#238b45','#006d2c','#00441b'))

#' Plot map using leaflet
#' @param data a data frame
Expand Down
22 changes: 15 additions & 7 deletions modules/04_overview_and_summaries.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -171,21 +171,29 @@ get_overview_summaries = function(cmdata, rank_dat) {
participation$group = factor(participation$group, levels = c("Whole group",
unique(group)))

groups = length(levels(participation$group)) == 1

if (isTRUE(groups)) {
participation$group = ""
legendshow = FALSE
}else{
legendshow = TRUE
}

partiplot =
ggplot(participation, aes(x = dc, y = value_perc,
group = group, color = group)) +
geom_line(linewidth = 1) +
geom_line(linewidth = 1.5, show.legend = legendshow) +
scale_y_continuous(limits = c(0, 1)) +
scale_colour_manual(values = col_pallet(length(unique(participation$group))),
name = "") +
scale_color_brewer(palette = "BrBG", name = "") +
theme_bw() +
theme(panel.background = element_blank(),
panel.grid = element_blank(),
axis.text.x = element_text(angle = 35, hjust = 1),
axis.text.x = element_text(angle = 45, hjust = 1),
legend.position = "top",
legend.text = element_text(size = 10, color = "grey20"),
axis.text = element_text(size = 10, color = "grey20"),
axis.title = element_text(size = 10, color = "grey20")) +
legend.text = element_text(size = 14, color = "grey20"),
axis.text = element_text(size = 14, color = "grey20"),
axis.title = element_text(size = 14, color = "grey20")) +
labs(x = "Trial stage", y = "Rate of response")


Expand Down
92 changes: 57 additions & 35 deletions modules/06_PlackettLuce_models.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -54,7 +54,16 @@ get_PlackettLuce_models = function(cmdata, rank_dat) {
logworth_plot[[m]] =
plot_logworth(mod[[m]], ref = reference_tech, ci.level = 0.5) +
labs(title = paste0(rank_dat$trait_names[m],
" (n = ", length(mod[[m]]$rankings),")"))
" (n = ", length(mod[[m]]$rankings),")")) +
coord_flip() +
theme(axis.text.x = element_text(angle = 0,
vjust = 0.5,
hjust = 0.5),
strip.background.x = element_blank(),
strip.placement = "outside",
strip.text = element_text(size = 10, color = "grey20"),
legend.text = element_text(size = 10, color = "grey20"),
axis.title = element_text(size = 10, color = "grey20"))
}

#...........................................................
Expand Down Expand Up @@ -92,7 +101,7 @@ get_PlackettLuce_models = function(cmdata, rank_dat) {
fill = winprob,
label = as.character(round(winprob, 2)))) +
geom_tile() +
scale_fill_distiller(palette = "RdBu",
scale_fill_distiller(palette = "BrBG",
limit = lims,
direction = 1,
na.value = "white",
Expand All @@ -101,16 +110,26 @@ get_PlackettLuce_models = function(cmdata, rank_dat) {
theme_bw() +
theme(axis.text = element_text(color = "grey20"),
strip.text.x = element_text(color = "grey20"),
axis.text.x = element_text(angle = 40,
axis.text.x = element_text(size = 10,
angle = 45,
vjust = 1,
hjust = 1),
axis.text.y = element_text(angle = 0,
vjust = 1, hjust = 1),
hjust = 1,
color = "grey20"),
axis.text.y = element_text(size = 10,
angle = 0,
vjust = 1,
hjust = 1,
color = "grey20"),
panel.grid = element_blank(),
strip.background.x = element_blank(),
strip.placement = "outside") +
strip.placement = "outside",
strip.text = element_text(size = 10, color = "grey20"),
legend.text = element_text(size = 10, color = "grey20"),
axis.title = element_text(size = 10, color = "grey20")) +
labs(x = "", y = "", fill = "")

worthmap

#...........................................................
# Analysis of variance ####
anovas = lapply(mod, function(x){
Expand Down Expand Up @@ -183,28 +202,33 @@ get_PlackettLuce_models = function(cmdata, rank_dat) {
# plot the reliability
reliability_plot =
ggplot(data = reliability_data,
aes(x = reliability,
y = item)) +
geom_bar(stat = "identity",
position = "dodge",
show.legend = FALSE,
width = 1,
color = "#e5f5f9",
fill = "#b2df8a") +
geom_vline(xintercept = 0.5,
aes(y = reliability,
x = item,
fill = "#b2df8a")) +
geom_chicklet(show.legend = FALSE) +
coord_flip() +
geom_hline(yintercept = 0.5,
colour = "#1f78b4",
linewidth = 1) +
scale_fill_manual(values = "#b2df8a") +
facet_wrap(~ Check, strip.position = "bottom") +
theme_bw() +
#theme_bw() +
theme_classic() +
theme(panel.grid.major = element_blank(),
strip.background =element_rect(fill="white"),
text = element_text(color = "grey20"),
strip.background.x = element_blank(),
strip.placement = "outside") +
labs(x = "Probability of outperforming",
y = "")
strip.placement = "outside",
strip.text = element_text(size = 12, color = "grey20"),
legend.text = element_text(size = 12, color = "grey20"),
axis.text = element_text(size = 12, color = "grey20"),
axis.title = element_text(size = 12, color = "grey20")) +
labs(y = "Probability of outperforming",
x = "")


reliability_plot

#.....................................................
#.....................................................
#.....................................................
Expand Down Expand Up @@ -265,25 +289,23 @@ get_PlackettLuce_models = function(cmdata, rank_dat) {
# make a bar plot plot
kendall_plot =
ggplot(data = kendall,
aes(x = kendallTau,
y = trait,
aes(y = kendallTau,
x = trait,
fill = trait)) +
geom_bar(stat = "identity",
position = "dodge",
show.legend = FALSE,
width = 1,
color = "#ffffff") +
scale_fill_manual(values = rev(col_pallet(nrow(kendall)))) +
geom_chicklet(show.legend = FALSE) +
coord_flip() +
scale_fill_manual(values = col_pallet(nrow(kendall))) +
theme_classic() +
theme(legend.position = "bottom",
legend.text = element_text(size = 9),
axis.text.y = element_text(color = "grey20"),
axis.text.x = element_text(vjust = 1,
legend.text = element_text(size = 12, color = "grey20"),
axis.text.y = element_text(size = 12, color = "grey20"),
axis.title = element_text(size = 12, color = "grey20"),
axis.text.x = element_text(size = 12,
vjust = 1,
hjust=1,
color = "grey20")) +
labs(y = "Trait",
x = "Kendall tau")

labs(x = "Trait",
y = "Kendall tau")

names(kendall) = c("Trait", "Kendall tau", "Z value", "Pr(>|z|)")

Expand Down Expand Up @@ -318,7 +340,7 @@ error_data_PL_model = list(PL_models = list(),
kendall = list(kendall = data.frame(),
strongest_link = "",
weakest_link = "",
kendall_plot = ""),
kendall_plot = 0L),
reliability_plot = 0L,
reliability_data = data.frame())

Expand Down
45 changes: 45 additions & 0 deletions modules/10_quantitative_insights.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -19,6 +19,7 @@ get_quantitative_summaries <- function(quanti_dat) {
b_i <- ggplot(ggdat_i, aes(y = value, x = technology, color = technology)) +
geom_boxplot(show.legend = FALSE) +
geom_jitter(show.legend = FALSE) +
scale_color_brewer(palette = "BrBG", name = "") +
labs(title = paste(unique(ggdat_i$trait), unique(ggdat_i$data_collection), sep = " - "),
x = "",
y = "") +
Expand Down Expand Up @@ -51,3 +52,47 @@ error_data_quantitative_traits <- list(density_plots = list(),
density_file_names = list())



#
#
# # first for yield
# yield = unlist(lapply(quanti_dat$quanti_dat, function(x){
# grepl("yieldperse", x$trait_code[1])
# }))
#
# yield = quanti_dat$quanti_dat[yield]
#
# dat = yield[[2]]
#
# dat = split(dat, dat$technology)
#
# unlist(lapply(dat, nrow))
#
# dat = lapply(dat, function(x){
# out = boxplot.stats(x[, "value"])$out
# rmv = !x[, "value"] %in% out
# x = x[rmv, ]
# x
# })
#
# dat = do.call("rbind", dat)
#
#
# ggplot(dat, aes(y = value, x = technology, color = technology)) +
# geom_boxplot(show.legend = FALSE) +
# geom_jitter(show.legend = FALSE) +
# scale_color_brewer(palette = "BrBG", name = "") +
# labs(title = paste(unique(dat$trait), unique(dat$data_collection), sep = " - "),
# x = "",
# y = "") +
# theme_bw() +
# theme(panel.grid = element_blank(),
# text = element_text(size = 16),
# title = element_text(size = 12),
# axis.text.x = element_text(angle = 45, hjust = 1))
#
# mod = lm(value ~ technology, data = dat)
#
# summary(mod)
#
#
Binary file added report/1000FARMS.jpg
View file
Loading
Sorry, something went wrong. Reload?
Sorry, we cannot display this file.
Sorry, this file is invalid so it cannot be displayed.
Loading

0 comments on commit 5cad87d

Please sign in to comment.