Skip to content

Commit 98fde7a

Browse files
kauedesousakauedesousa
authored
Merge pull request #113 from AgrDataSci/devel
Devel
2 parents b2750f0 + d657f2b commit 98fde7a

8 files changed

+138
-81
lines changed

‎ClimMob.R

+9-21
Original file line numberDiff line numberDiff line change
@@ -161,7 +161,8 @@ if (any_error(org_lonlat)) {
161161
org_agroclim = tryCatch({
162162

163163
agroclimate = get_agroclimatic_data(cmdata,
164-
coords = trial_map$coords)
164+
coords = trial_map$coords,
165+
ndays = 60)
165166

166167
}, error = function(cond) {
167168
return(cond)
@@ -333,7 +334,7 @@ dir.create(chartdir, recursive = TRUE, showWarnings = FALSE)
333334

334335
# log worth plot by trait
335336
for(m in seq_along(PL_models$logworth_plot)){
336-
try(ggsave(paste0(chartdir, rank_dat$trait_code[m], "_logworth.png"),
337+
try(ggsave(paste0(chartdir, m, "-logworth.pdf"),
337338
plot = PL_models$logworth_plot[[m]],
338339
width = 21,
339340
height = 15,
@@ -342,23 +343,23 @@ for(m in seq_along(PL_models$logworth_plot)){
342343
}
343344

344345
# plot kendall tau plot
345-
try(ggsave(paste0(chartdir, "kendall_tau.png"),
346+
try(ggsave(paste0(chartdir, "kendall_tau.pdf"),
346347
plot = PL_models$kendall$kendall_plot,
347348
width = 15,
348349
height = 18,
349350
units = "cm",
350351
dpi = 200), silent = TRUE)
351352

352353
# plot worth map
353-
try(ggsave(paste0(chartdir, "worth_map.png"),
354+
try(ggsave(paste0(chartdir, "worth_map.pdf"),
354355
plot = PL_models$worthmap,
355356
width = 25,
356357
height = 25,
357358
units = "cm",
358359
dpi = 200), silent = TRUE)
359360

360361
# plot worth map
361-
try(ggsave(paste0(chartdir, "reliability.png"),
362+
try(ggsave(paste0(chartdir, "reliability.pdf"),
362363
plot = PL_models$reliability_plot,
363364
width = 25,
364365
height = 25,
@@ -368,21 +369,8 @@ try(ggsave(paste0(chartdir, "reliability.png"),
368369
try(write.csv(PL_models$reliability_data, paste0(chartdir, "reliability_data.csv"),
369370
row.names = FALSE), silent = TRUE)
370371

371-
if(length(unique(rank_dat$group)) > 1) {
372-
g = unique(rank_dat$group)
373-
# log worth plot by group
374-
for(m in seq_along(PL_models$logworth_plot_groups)){
375-
try(ggsave(paste0(chartdir, "Group", m, "_", g[m], "_logworth_grouped_rank.png"),
376-
plot = PL_models$logworth_plot_groups[[m]],
377-
width = 21,
378-
height = 15,
379-
units = "cm",
380-
dpi = 200), silent = TRUE)
381-
}
382-
}
383-
384372
if(PL_tree$isTREE){
385-
try(ggsave(paste0(chartdir, "PlackettLuce.png"),
373+
try(ggsave(paste0(chartdir, "PlackettLuceTree.pdf"),
386374
plot = PL_tree$PLtree_plot,
387375
width = 18,
388376
height = 25,
@@ -401,14 +389,14 @@ if (isTRUE(agroclimate$agroclimate)) {
401389
file = paste0(chartdir, "weekly_temperature_indices.csv"),
402390
row.names = FALSE)
403391

404-
try(ggsave(paste0(chartdir, "weekly_precipitation_indices.png"),
392+
try(ggsave(paste0(chartdir, "weekly_precipitation_indices.pdf"),
405393
plot = agroclimate$rain_plot,
406394
width = 20,
407395
height = 20,
408396
units = "cm",
409397
dpi = 200), silent = TRUE)
410398

411-
try(ggsave(paste0(chartdir, "weekly_temperature_indices.png"),
399+
try(ggsave(paste0(chartdir, "weekly_temperature_indices.pdf"),
412400
plot = agroclimate$temperature_plot,
413401
width = 20,
414402
height = 20,

‎NEWS.md

+13
Original file line numberDiff line numberDiff line change
@@ -1,3 +1,16 @@
1+
ClimMob-analysis v3.0 (2024-01-25)
2+
=========================
3+
4+
### Improvements
5+
6+
* Adds analysis of variance for variety performance
7+
* Adds pseudo ranking when network is poorly connected
8+
9+
### Bug fixes
10+
11+
* Fixes changes in reference for the log-worth plot
12+
13+
114
ClimMob-analysis v2.1 (2022-12-15)
215
=========================
316

‎modules/01_functions.R

+72-12
Original file line numberDiff line numberDiff line change
@@ -35,6 +35,59 @@ library("janitor")
3535
library("lubridate")
3636
library("ggchicklet")
3737

38+
39+
#' Add pseudo ranking
40+
#' Adds pseudo values to weakly connected networks
41+
#' @param x a PlackettLuce ranking object
42+
force_pseudo_rank = function(x) {
43+
44+
# get membership in the network
45+
members = PlackettLuce::connectivity(x)$membership
46+
# put the members in order
47+
members = sort(members)
48+
# rankings into a matrix
49+
r = unclass(x)
50+
51+
performance = coefficients(PlackettLuce::PlackettLuce(r))
52+
53+
# get the worst item per cluster
54+
members = split(members, members)
55+
56+
members = lapply(members, function(z){
57+
p = performance[names(z)]
58+
worst = which.min(p)
59+
names(p)[worst]
60+
})
61+
62+
members = as.character(unlist(members))
63+
64+
# create a pseudo ranking for these members where they will always
65+
# lose and win to each other
66+
# number to start ranking
67+
max_rank = max(r) + 1
68+
69+
# rows to add the pseudo rankings
70+
to_input = rowSums(r) != 0
71+
72+
to_sample = c(rep(0, ceiling(length(members)/2)),
73+
max_rank:(max_rank + ceiling(length(members)/2)))
74+
75+
# rows to add the pseudo rankings
76+
r[to_input, members] = apply(r[to_input, members], 1, function(y){
77+
78+
where = y == 0
79+
80+
y[where] = sample(to_sample, size = length(y[where]))
81+
82+
y
83+
84+
})
85+
86+
r = as.rankings(r)
87+
88+
}
89+
90+
3891
#'Get colour pallet
3992
#' @param x an integer
4093
#' @examples
@@ -577,6 +630,12 @@ decode_pars = function(x) {
577630
tr = toupper(tr)
578631
}
579632

633+
if (any(grepl("generalappreciation", tr))) {
634+
i = which(grepl("generalappreciation", tr))[1]
635+
questions$traitOrder[i] = "referenceTrait"
636+
tr = toupper(tr)
637+
}
638+
580639
if (any(grepl("yield", tr))) {
581640
i = which(grepl("yield", tr))[1]
582641
questions$traitOrder[i] = "referenceTrait"
@@ -794,7 +853,8 @@ multcompPL = function(mod, items = NULL, threshold = 0.05, adjust = "none", ...)
794853
#' @param ci.level the confidence interval level
795854
#' @param multcomp logical to add group letters
796855
#' @param levels an optional vector with factor levels to plot
797-
plot_logworth = function(x, ci.level = 0.95, ref = NULL, multcomp = TRUE, levels = NULL, ...) {
856+
plot_logworth = function(x, ci.level = 0.95, ref = NULL,
857+
multcomp = TRUE, levels = NULL, ...) {
798858

799859
frame = data.frame()
800860

@@ -806,7 +866,7 @@ plot_logworth = function(x, ci.level = 0.95, ref = NULL, multcomp = TRUE, levels
806866
}
807867

808868
if (is.null(levels)) {
809-
levels = unique(frame$items)
869+
levels = union(ref, sort(unique(frame$items)))
810870
}
811871

812872
items = factor(frame$items, levels = levels)
@@ -838,29 +898,29 @@ plot_logworth = function(x, ci.level = 0.95, ref = NULL, multcomp = TRUE, levels
838898
pdat$items = factor(pdat$items, levels = levels)
839899

840900
p = ggplot(data = pdat,
841-
aes(x = items,
842-
y = est,
843-
ymax = tops,
844-
ymin = tails,
901+
aes(y = items,
902+
x = est,
903+
xmax = tops,
904+
xmin = tails,
845905
label = group)) +
846-
geom_hline(yintercept = 0,
906+
geom_vline(xintercept = 0,
847907
colour = "#E5E7E9",
848908
linewidth = 0.8) +
849909
geom_point() +
850910
geom_errorbar(width = 0.1) +
851-
geom_text(vjust = 1.2, hjust = 1.2) +
911+
geom_text(hjust = 1.2, vjust = 1.2) +
852912
theme_bw() +
853913
facet_wrap(~ ref, strip.position = "bottom") +
854914
theme(panel.grid.major = element_blank(),
855-
axis.text.x = element_text(angle = 45, vjust = 1, hjust=1,
856-
size = 10, color = "grey20"),
915+
strip.background.x = element_blank(),
857916
axis.text.y = element_text(size = 10, color = "grey20"),
917+
axis.text.x = element_text(size = 10, color = "grey20"),
858918
text = element_text(color = "grey20"),
859919
legend.position = "bottom",
860920
legend.title = element_blank(),
861-
strip.background.x = element_blank(),
921+
strip.background.y = element_blank(),
862922
strip.placement = "outside") +
863-
labs(x = "", y = "Log-worth")
923+
labs(y = "", x = "Log-worth")
864924

865925
p
866926

‎modules/03_organize_quantitative_data.R

+7-2
Original file line numberDiff line numberDiff line change
@@ -36,15 +36,20 @@ organize_quantitative_data = function(cmdata,
3636
id = "id",
3737
tech_index = c("package_item_A", "package_item_B", "package_item_C")) {
3838

39+
40+
quanti_traits = pars[["linear"]]
41+
42+
if (length(quanti_traits) == 0) {
43+
return(list(quantitative = FALSE))
44+
}
45+
3946
# from json to data.frame
4047
cmdata = as.data.frame(x = cmdata,
4148
tidynames = FALSE,
4249
pivot.wider = TRUE)
4350

4451
ntech = length(tech_index)
4552

46-
quanti_traits = pars[["linear"]]
47-
4853
# check if a request to split the data by groups (segments)
4954
# (gender, location, etc.) is provided
5055
if (isTRUE(length(groups) > 0)) {

‎modules/05_spatial_overview.R

+3-8
Original file line numberDiff line numberDiff line change
@@ -60,20 +60,15 @@ get_testing_sites_map = function(cmdata, output_path, backward_path){
6060
minimap = TRUE,
6161
map_provider = "OpenStreetMap.Mapnik")
6262

63-
tempmap = paste0(getwd(), "/tempmap/")
64-
65-
dir.create(tempmap, recursive = TRUE, showWarnings = FALSE)
66-
6763
try(mapview::mapshot(trial_map,
68-
url = paste0(tempmap, "/trial_map.html"),
69-
file = paste0(tempmap, "/trial_map.png")),
64+
url = paste0(output_path, "/trial_map.html"),
65+
file = paste0(output_path, "/trial_map.png")),
7066
silent = TRUE)
7167

7268
}
7369

7470
result = list(geoTRUE = TRUE,
75-
mapDIR = tempmap,
76-
map_path = paste0(tempmap, "/trial_map.png"),
71+
map_path = paste0(fullpath, "/", output_path, "/trial_map.png"),
7772
map = trial_map,
7873
coords = lonlat)
7974

0 commit comments

Comments
 (0)