Merge pull request #63 from AgrDataSci/devel

Devel

ClimMob.R

@@ -227,6 +227,19 @@ org_rank <- tryCatch({
 
     }
 
+    # replace Not observed entries with NA
+    rpl <- cmdata[trait_i]
+    rpl[rpl == "Not observed"] <- NA
+    cmdata[trait_i] <- rpl
+
+    # if all the three items are tied than set this entry as NA
+    # as it results in issues on PlackettLuce its S3 methods
+    tied <- as.vector(apply(cmdata[trait_i], 1, function(x) {
+      all(x == "Tie") & all(!is.na(x))
+    }))
+
+    cmdata[tied, trait_i] <- NA
+
     # check for data completeness in this trait
     # should return a vector with TRUE, FALSE, 
     # where TRUE = complete, FALSE = missing
@@ -919,29 +932,13 @@ try_pl <- tryCatch({
 
     ot <- other_traits_list[[i]]
 
-    # if (isTRUE(tricotVSlocal)) {
-    #   
-    #   keep <- overall$keep2 & ot$keep
-    #   
-    #   a <- list(cmdata[keep, c(itemnames, ot$strings, overall$tricotVSlocal)],
-    #             items = itemnames,
-    #             input = ot$strings,
-    #             additional.rank = cmdata[keep, overall$tricotVSlocal])
-    #   
-    #   Rot <- do.call(rankwith, args = a)
-    #   
-    # }
-    # 
-    # if (isFALSE(tricotVSlocal)) {
-      keep <- ot$keep
+    keep <- ot$keep
 
-      a <- list(data  = cmdata[keep, c(itemnames, ot$strings)],
-                items = itemnames,
-                input = ot$strings)
-
-      Rot <- do.call(rankwith, args = a)
-
-    #}
+    a <- list(data  = cmdata[keep, c(itemnames, ot$strings)],
+              items = itemnames,
+              input = ot$strings)
+
+    Rot <- do.call(rankwith, args = a)
 
     mod_t <- PlackettLuce(Rot)
 

NEWS.md

@@ -1,4 +1,4 @@
-ClimMob-analysis v1.2 (2021-02-24)
+ClimMob-analysis v1.2 (2021-03-17)
 =========================
 
 ### Improvements
@@ -13,6 +13,7 @@ ClimMob-analysis v1.2 (2021-02-24)
 * Information on the data collection moment is provided and linked to their respective traits and covariates. This will help the reader to find out which trait/covariate belongs to the data collection moment, mostly when the trait/covariate is collected in more than one data collection moment.
 * An alpha of 0.5 is used in the Plackett-Luce tree for the main trait. This is to enable the creation of trees even with a small sample size. The algorithm still prints the message if the tree has significant groups with an alpha of 0.1 (default for the analysis).
 * Minor improvements in sorting the traits for the participants' reports and how traits and question asked are displayed.
+* Analysis will handle ties (if any)
 
 ### BUG FIXES
 

R/participant_report.R

@@ -27,33 +27,26 @@ keep <- overall$keep
 # create the rankings
 a <- list(cmdata[keep, ],
           items = itemnames,
-          input = overall$strings)
+          input = overall$strings, 
+          full.output = TRUE)
 
 R <- do.call(rankwith, args = a)
 
-order_items <- coef(PlackettLuce(R), ref = reference)
+order_items <- coef(PlackettLuce(R[["PLranking"]]), ref = reference)
+
+# do this to remove ties
+order_items <- order_items[names(order_items) %in% items]
 
 rank_items <- gosset:::.rank_decimal(order_items)$rank
 
 order_items <- names(order_items)
 
 freq_items <- table(unlist(itemdata))
 
-R <- R[1:nrow(R),, as.rankings = FALSE]
-R[R == 0] <- NA
-
-first <- apply(R, 1, function(x){
-  i <- which.min(x)
-  names(x)[i]
-}) 
-
-last <- apply(R, 1, function(x){
-  i <- which.max(x)
-  names(x)[i]
-}) 
+ordering <- R[["myrank"]]
 
-first_items <- table(first)
-last_items  <- table(last)
+first_items <- table(ordering[,1])
+last_items  <- table(ordering[,3])
 
 infotable <- data.frame(item = order_items,
                         rank = rank_items,
@@ -73,18 +66,6 @@ partitable <- cmdata[, sel]
 
 names(partitable) <- gsub("package_|farmer", "", names(partitable))
 
-# now get the items that where ranked from first to last by 
-# each participant
-ord <- t(apply(R, 1, function(x){
-  x <- na.omit(x)
-  x <- sort(x)
-  names(x)
-}))
-
-ord <- as.data.frame(ord)
-
-names(ord) <- paste0("Position", 1:ncomp)
-
 # empty matrix to expand values from ord so it can fit partitable
 # in case of missing data when participants did not replied the reference trait
 x <- matrix(NA, 
@@ -94,7 +75,7 @@ x <- matrix(NA,
 
 partitable <- cbind(partitable, x)
 
-partitable[keep, paste0("Position", 1:ncomp)] <- ord
+partitable[keep, paste0("Position", 1:ncomp)] <- ordering
 
 # fill NAs with "Not replied" in the first case and then with an empty character
 partitable$Position1[is.na(partitable$Position1)] <- "Not replied"
@@ -119,19 +100,10 @@ if(isTRUE(nothertraits > 0)){
 
     a <- list(cmdata[ot$keep, ],
               items = itemnames,
-              input = ot$strings)
+              input = ot$strings,
+              full.output = TRUE)
 
-    R <- do.call(rankwith, args = a)
-
-    R <- R[1:nrow(R),, as.rankings = FALSE]
-
-    R[R == 0] <- NA
-
-    R <- t(apply(R, 1, function(x){
-      x <- na.omit(x)
-      x <- sort(x)
-      names(x)
-    }))
+    R <- do.call(rankwith, args = a)[["myrank"]]
 
     # expand the rankings (in rows) so it can fit with the full
     # information to include those participants who did not replied the
@@ -385,11 +357,12 @@ for(i in seq_along(partitable$id)){
 
   text(x=xtop, 
        y=ytop[1], 
-       paste0(name, "'s Certificate of Participation in a ClimMob Experiment"), 
+       paste0("Certificate of Participation in a ClimMob Experiment"), 
        cex=textsize_2, 
        adj=c(0, NA))
-
-  text(x=xtop,y=ytop[3], 
+
+  text(x=xtop,
+       y=ytop[3], 
        paste(nranker, rankers, "contributed to this experiment."), 
        cex=textsize_1, 
        adj=c(0, NA))
@@ -411,7 +384,7 @@ for(i in seq_along(partitable$id)){
 
   text(x=xtop,
        y=ytop[7], 
-       "Thank you for your participation!", 
+       paste("Thank you", name, "for your participation!"), 
        font=2, 
        cex=textsize_1, 
        adj=c(0, NA))

README.md

@@ -21,7 +21,10 @@ This repository contains the code used in the workflow to analyse data and creat
 
 ## Meta
 
-  - Please [report any issues or bugs](https://github.com/agrobioinfoservices/ClimMob-analysis/issues)
+  - Please [report any issues or bugs](https://github.com/agrdatasci/ClimMob-analysis/issues)
   - License: [CC BY 4.0](https://creativecommons.org/licenses/by/4.0/)
-  - The [Tricot user guide](https://hdl.handle.net/10568/109942) shows how the experimental method inside the [ClimMob](https://climmob.net/) platform works
+  - The [Tricot user guide](https://hdl.handle.net/10568/109942) shows how the experimental method inside the ClimMob platform
+  - The [ClimMob](https://climmob.net/) platform is an free on-line software for experimental trials with the tricot citizen-science approach
+
+