Commit ⋅ agrdatasci/ClimMobTools

#' @param as.data.frame logical, to return a data frame
#' @param ... additional arguments passed to methods
#' @inheritParams getProjectsCM
#' @return An object of class 'CM_list' or a data.frame with the 
#' @return An object of class 'CM_list' or a data.frame with class "CM_df" with the 
#' variables:
#' \item{id}{the participant's package id}
#' \item{moment}{the data collection moment}

@@ -33,7 +33,6 @@

#' @seealso ClimMob website \url{https://climmob.net/}
#' @importFrom httr accept_json content RETRY
#' @importFrom jsonlite fromJSON
#' @importFrom tibble as_tibble
#' @export
getDataCM <- function(key = NULL, 
                      project = NULL, 

@@ -64,7 +63,6 @@

  # if required, coerce to a data frame
  if (isTRUE(as.data.frame)) {
    cmdata <- as.data.frame(x = cmdata, ...)
    cmdata <- tibble::as_tibble(cmdata)
  }
  
  return(cmdata)

@@ -0,0 +1,82 @@

1	+	#' @method print CM_df
2	+	#' @export
3	+	print.CM_df <- function(x, ...){
4	+
5	+	x <- as.data.frame(x, stringAsFactor = FALSE)
6	+
7	+	classes <- lapply(x, function(y){
8	+	class(y)
9	+	})
10	+
11	+	classes <- as.vector(unlist(classes))
12	+	class_abb = c(list = "<list>", integer = "<int>", numeric = "<dbl>",
13	+	character = "<chr>", Date = "<date>", complex = "<cpl>",
14	+	factor = "<fct>", POSIXct = "<POSc>", logical = "<lgl>",
15	+	IDate = "<IDat>", integer64 = "<i64>", raw = "<raw>",
16	+	expression = "<expr>", ordered = "<ord>")
17	+
18	+	abbs <- unname(class_abb[classes])
19	+
20	+	nc <- dim(x)[[2]]
21	+	nr <- dim(x)[[1]]
22	+
23	+	dbl <- abbs %in% "<dbl>"
24	+
25	+	x[dbl] <- lapply(x[dbl], function(y){
26	+	format(round(y, 2), nsmall = 2)
27	+	})
28	+
29	+	x[1:nc] <- lapply(x, as.character)
30	+
31	+	if (nr <= 10L) {
32	+
33	+	toprint <- rbind(abbs, x)
34	+
35	+	rownames(toprint) <- c("", paste0(row.names(x), ":"))
36	+
37	+	}
38	+
39	+	if (nr > 10L) {
40	+
41	+	he <- .head(x)
42	+
43	+	ta <- .tail(x)
44	+
45	+	toprint <- rbind(abbs,
46	+	he,
47	+	rep("", dim(x)[[2]]),
48	+	ta)
49	+
50	+	rownames(toprint) <- c("",
51	+	paste0(row.names(he), ":"),
52	+	"---",
53	+	paste0(row.names(ta), ":"))
54	+
55	+	}
56	+
57	+	print(toprint)
58	+
59	+	}
60	+
61	+
62	+	.tail <- function(x, n = 5L, addrownums = TRUE, ...) {
63	+	stopifnot(length(n) == 1L)
64	+	nrx <- nrow(x)
65	+	n <- if (n < 0L)
66	+	max(nrx + n, 0L)
67	+	else min(n, nrx)
68	+	sel <- as.integer(seq.int(to = nrx, length.out = n))
69	+	ans <- x[sel, , drop = FALSE]
70	+	if (addrownums && is.null(rownames(x)))
71	+	rownames(ans) <- format(sprintf("[%d,]", sel), justify = "right")
72	+	ans
73	+	}
74	+
75	+
76	+	.head <- function (x, n = 5L, ...) {
77	+	stopifnot(length(n) == 1L)
78	+	n <- if (n < 0L)
79	+	max(nrow(x) + n, 0L)
80	+	else min(n, nrow(x))
81	+	x[seq_len(n), , drop = FALSE]
82	+	}

@@ -46,10 +46,12 @@

  namevar <- c("N bags", "Bags per variety", 
               "Seeds per variety", "Seeds total")
  
  result <- tibble::tibble(var = namevar,
                           quant= c(nbags, bagsvar, seedsvar, seedstotal),
                           unit = c(rep("unit",2), rep(unit, 2)))
  result <- data.frame(var = namevar,
                       quant= c(nbags, bagsvar, seedsvar, seedstotal),
                       unit = c(rep("unit",2), rep(unit, 2)),
                       stringsAsFactors = FALSE)
  
  class(result) <- union("CM_df", class(result))
  
  return(result)
  

@@ -62,7 +62,9 @@

  
  dat$creation_date <- with(dat, as.Date(creation_date, origin = "1970-01-01"))

  dat <- tibble::as_tibble(dat)
  dat <- as.data.frame(dat, stringsAsFactors = FALSE)
  
  class(dat) <- union("CM_df", class(dat))
  
  return(dat)
}

@@ -293,6 +293,8 @@

  
  row.names(output) <- seq_along(output$id)
  
  class(output) <- union("CM_df", class(output))
  
  return(output)
  
}

@@ -32,8 +32,6 @@

#' @importFrom Matrix Diagonal
#' @importFrom methods as
#' @importFrom RSpectra eigs
#' @importFrom utils combn
#' @importFrom tibble as_tibble
#' @export
randomise <- function(ncomp = 3, nobservers = NULL, nitems = NULL, 
                      itemnames = NULL) {

@@ -62,7 +60,7 @@

  varieties <- seq_len(nitems)
  
  # Full set of all combinations
  varcombinations <- t((utils::combn(varieties, ncomp)))
  varcombinations <- t((.combn(varieties, ncomp)))
  
  # if the full set of combinations is small and can be covered at least once
  # the set will include each combination at least once

@@ -118,7 +116,7 @@

        for (k in 1:length(selected)) {
          
          evalgraph <- varcomb
          index <- t(combn(varcombinations[selected[k],], 2))
          index <- t(.combn(varcombinations[selected[k],], 2))
          evalgraph[index] <- evalgraph[index] + 1
          khi[k] <- .KirchhoffIndex(evalgraph)
          

@@ -137,8 +135,8 @@

      # assign the selected combination
      vars2[i,] <- varcombinations[selected,]
      
      varcomb[t(combn(varcombinations[selected,],2))] <- 
        varcomb[t(combn(varcombinations[selected,],2))] + 1
      varcomb[t(.combn(varcombinations[selected,],2))] <- 
        varcomb[t(.combn(varcombinations[selected,],2))] + 1
      
      # remove used combination
      varcombinations <- varcombinations[-selected,]

@@ -157,7 +155,7 @@

  
  # fill first row
  selected <- sample(1:nobservers, 1)
  varcomb[t(combn(vars[selected,],2))] <- 1
  varcomb[t(.combn(vars[selected,],2))] <- 1
  varOrdered[1,] <- vars[selected,]
  vars <- vars[-selected,]
  

@@ -193,7 +191,7 @@

      # in this case, get matrix to calculate Kirchhoff index only for 
      # last 10 observers
      for (j in max(1,i-10):(i-1)) {
        index <- t(combn(varOrdered[j,],2))
        index <- t(.combn(varOrdered[j,],2))
        sumcombMatrix[index] <- sumcombMatrix[index] + 1
        
      }

@@ -204,7 +202,7 @@

      for (k in 1:length(selected)) {
        
        evalgraph <- sumcombMatrix
        index <- t(combn(vars[selected[k],], 2))
        index <- t(.combn(vars[selected[k],], 2))
        evalgraph[index] <- evalgraph[index] + 1
        khi[k] <- .KirchhoffIndex(evalgraph)
        

@@ -222,7 +220,7 @@

    
    # assign the selected combination
    varOrdered[i,] <- vars[selected,]
    varcomb[t(combn(vars[selected,],2))] <- varcomb[t(combn(vars[selected,],2))] + 1
    varcomb[t(.combn(vars[selected,], 2))] <- varcomb[t(.combn(vars[selected,], 2))] + 1
    
    # remove used combination
    vars <- vars[-selected, ]

@@ -271,7 +269,9 @@

  dimnames(finalresults) <- list(seq_len(nobservers), 
                                 paste0("item_", LETTERS[1:ncomp]))
  
  finalresults <- tibble::as_tibble(finalresults)
  finalresults <- as.data.frame(finalresults, stringsAsFactors = FALSE)
  
  class(finalresults) <- union("CM_df", class(finalresults))
  
  return(finalresults)
  

@@ -347,4 +347,82 @@

347	347		xi[x] <- 1
348	348		return(.shannon(sumcomb + xi))
349	349
	350	+	}
	351	+
	352	+
	353	+	.combn <- function (x, m, FUN = NULL, simplify = TRUE, ...)
	354	+	{
	355	+	stopifnot(length(m) == 1L, is.numeric(m))
	356	+	if (m < 0)
	357	+	stop("m < 0", domain = NA)
	358	+	if (is.numeric(x) && length(x) == 1L && x > 0 && trunc(x) ==
	359	+	x)
	360	+	x <- seq_len(x)
	361	+	n <- length(x)
	362	+	if (n < m)
	363	+	stop("n < m", domain = NA)
	364	+	x0 <- x
	365	+	if (simplify) {
	366	+	if (is.factor(x))
	367	+	x <- as.integer(x)
	368	+	}
	369	+	m <- as.integer(m)
	370	+	e <- 0
	371	+	h <- m
	372	+	a <- seq_len(m)
	373	+	nofun <- is.null(FUN)
	374	+	if (!nofun && !is.function(FUN))
	375	+	stop("'FUN' must be a function or NULL")
	376	+	len.r <- length(r <- if (nofun) x[a] else FUN(x[a], ...))
	377	+	count <- as.integer(round(choose(n, m)))
	378	+	if (simplify) {
	379	+	dim.use <- if (nofun)
	380	+	c(m, count)
	381	+	else {
	382	+	d <- dim(r)
	383	+	if (length(d) > 1L)
	384	+	c(d, count)
	385	+	else if (len.r > 1L)
	386	+	c(len.r, count)
	387	+	else c(d, count)
	388	+	}
	389	+	}
	390	+	if (simplify)
	391	+	out <- matrix(r, nrow = len.r, ncol = count)
	392	+	else {
	393	+	out <- vector("list", count)
	394	+	out[[1L]] <- r
	395	+	}
	396	+	if (m > 0) {
	397	+	i <- 2L
	398	+	nmmp1 <- n - m + 1L
	399	+	while (a[1L] != nmmp1) {
	400	+	if (e < n - h) {
	401	+	h <- 1L
	402	+	e <- a[m]
	403	+	j <- 1L
	404	+	}
	405	+	else {
	406	+	e <- a[m - h]
	407	+	h <- h + 1L
	408	+	j <- 1L:h
	409	+	}
	410	+	a[m - h + j] <- e + j
	411	+	r <- if (nofun)
	412	+	x[a]
	413	+	else FUN(x[a], ...)
	414	+	if (simplify)
	415	+	out[, i] <- r
	416	+	else out[[i]] <- r
	417	+	i <- i + 1L
	418	+	}
	419	+	}
	420	+	if (simplify) {
	421	+	if (is.factor(x0)) {
	422	+	levels(out) <- levels(x0)
	423	+	class(out) <- class(x0)
	424	+	}
	425	+	dim(out) <- dim.use
	426	+	}
	427	+	out
350	428		}

Files		•	•	•	Coverage
R	486	332	0	154	68.31%
Project Totals (7 files)	486	332	0	154	68.31%

View CI Build Download

1	comment: false

Read the docs

Interact now

The inner-most circle is the entire project, moving away from the center are folders then, finally, a single file. The size and color of each slice is representing the number of statements and the coverage, respectively.

SVG

The top section represents the entire project. Proceeding with folders and finally individual files. The size and color of each slice is representing the number of statements and the coverage, respectively.

SVG

Each block represents a single file in the project. The size and color of each block is represented by the number of statements and the coverage, respectively.

SVG

Learn more about the coverage sunburst graph

293	293
294	294		row.names(output) <- seq_along(output$id)
295	295
	296	+	class(output) <- union("CM_df", class(output))
	297	+
296	298		return(output)
297	299
298	300		}

118	116		for (k in 1:length(selected)) {
119	117
120	118		evalgraph <- varcomb
121		-	index <- t(combn(varcombinations[selected[k],], 2))
	119	+	index <- t(.combn(varcombinations[selected[k],], 2))
122	120		evalgraph[index] <- evalgraph[index] + 1
123	121		khi[k] <- .KirchhoffIndex(evalgraph)
124	122

137	135		# assign the selected combination
138	136		vars2[i,] <- varcombinations[selected,]
139	137
140		-	varcomb[t(combn(varcombinations[selected,],2))] <-
141		-	varcomb[t(combn(varcombinations[selected,],2))] + 1
	138	+	varcomb[t(.combn(varcombinations[selected,],2))] <-
	139	+	varcomb[t(.combn(varcombinations[selected,],2))] + 1
142	140
143	141		# remove used combination
144	142		varcombinations <- varcombinations[-selected,]

157	155
158	156		# fill first row
159	157		selected <- sample(1:nobservers, 1)
160		-	varcomb[t(combn(vars[selected,],2))] <- 1
	158	+	varcomb[t(.combn(vars[selected,],2))] <- 1
161	159		varOrdered[1,] <- vars[selected,]
162	160		vars <- vars[-selected,]
163	161

204	202		for (k in 1:length(selected)) {
205	203
206	204		evalgraph <- sumcombMatrix
207		-	index <- t(combn(vars[selected[k],], 2))
	205	+	index <- t(.combn(vars[selected[k],], 2))
208	206		evalgraph[index] <- evalgraph[index] + 1
209	207		khi[k] <- .KirchhoffIndex(evalgraph)
210	208

10	10		#' @param as.data.frame logical, to return a data frame
11	11		#' @param ... additional arguments passed to methods
12	12		#' @inheritParams getProjectsCM
13		-	#' @return An object of class 'CM_list' or a data.frame with the
	13	+	#' @return An object of class 'CM_list' or a data.frame with class "CM_df" with the
14	14		#' variables:
15	15		#' \item{id}{the participant's package id}
16	16		#' \item{moment}{the data collection moment}

33	33		#' @seealso ClimMob website \url{https://climmob.net/}
34	34		#' @importFrom httr accept_json content RETRY
35	35		#' @importFrom jsonlite fromJSON
36		-	#' @importFrom tibble as_tibble
37	36		#' @export
38	37		getDataCM <- function(key = NULL,
39	38		project = NULL,

64	63		# if required, coerce to a data frame
65	64		if (isTRUE(as.data.frame)) {
66	65		cmdata <- as.data.frame(x = cmdata, ...)
67		-	cmdata <- tibble::as_tibble(cmdata)
68	66		}
69	67
70	68		return(cmdata)

46	46		namevar <- c("N bags", "Bags per variety",
47	47		"Seeds per variety", "Seeds total")
48	48
49		-	result <- tibble::tibble(var = namevar,
50		-	quant= c(nbags, bagsvar, seedsvar, seedstotal),
51		-	unit = c(rep("unit",2), rep(unit, 2)))
	49	+	result <- data.frame(var = namevar,
	50	+	quant= c(nbags, bagsvar, seedsvar, seedstotal),
	51	+	unit = c(rep("unit",2), rep(unit, 2)),
	52	+	stringsAsFactors = FALSE)
52	53
	54	+	class(result) <- union("CM_df", class(result))
53	55
54	56		return(result)
55	57

62	62
63	63		dat$creation_date <- with(dat, as.Date(creation_date, origin = "1970-01-01"))
64	64
65		-	dat <- tibble::as_tibble(dat)
	65	+	dat <- as.data.frame(dat, stringsAsFactors = FALSE)
	66	+
	67	+	class(dat) <- union("CM_df", class(dat))
66	68
67	69		return(dat)
68	70		}

32	32		#' @importFrom Matrix Diagonal
33	33		#' @importFrom methods as
34	34		#' @importFrom RSpectra eigs
35		-	#' @importFrom utils combn
36		-	#' @importFrom tibble as_tibble
37	35		#' @export
38	36		randomise <- function(ncomp = 3, nobservers = NULL, nitems = NULL,
39	37		itemnames = NULL) {

62	60		varieties <- seq_len(nitems)
63	61
64	62		# Full set of all combinations
65		-	varcombinations <- t((utils::combn(varieties, ncomp)))
	63	+	varcombinations <- t((.combn(varieties, ncomp)))
66	64
67	65		# if the full set of combinations is small and can be covered at least once
68	66		# the set will include each combination at least once

193	191		# in this case, get matrix to calculate Kirchhoff index only for
194	192		# last 10 observers
195	193		for (j in max(1,i-10):(i-1)) {
196		-	index <- t(combn(varOrdered[j,],2))
	194	+	index <- t(.combn(varOrdered[j,],2))
197	195		sumcombMatrix[index] <- sumcombMatrix[index] + 1
198	196
199	197		}

222	220
223	221		# assign the selected combination
224	222		varOrdered[i,] <- vars[selected,]
225		-	varcomb[t(combn(vars[selected,],2))] <- varcomb[t(combn(vars[selected,],2))] + 1
	223	+	varcomb[t(.combn(vars[selected,], 2))] <- varcomb[t(.combn(vars[selected,], 2))] + 1
226	224
227	225		# remove used combination
228	226		vars <- vars[-selected, ]

271	269		dimnames(finalresults) <- list(seq_len(nobservers),
272	270		paste0("item_", LETTERS[1:ncomp]))
273	271
274		-	finalresults <- tibble::as_tibble(finalresults)
	272	+	finalresults <- as.data.frame(finalresults, stringsAsFactors = FALSE)
	273	+
	274	+	class(finalresults) <- union("CM_df", class(finalresults))
275	275
276	276		return(finalresults)
277	277

Navigation	Overlay
`t` Navigate files	`h` Toggle hits
`y` Change url to tip of branch	`m` Toggle misses
`b / v` Jump to prev/next hit line	`p` Toggle partial
`z / x` Jump to prev/next missed or partial line	`1..9` Toggle flags
`shift + o` Open current page in GitHub	`a` Toggle all on
`/ or ?` Show keyboard shortcuts dialog	`c` Toggle context lines or commits

Updating our web app