Compare `4623509 ... +0 ... 7180aee`

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	+	}

@@ -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		}

@@ -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)
  
}

@@ -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)
  

Click to load this diff.

Loading diff...

Learn more Showing 1 files with coverage changes found.

New file R/print.R

New

Loading file...

7180aee

+1 Files

+109

+48

+61

75.33% ø ø

updated-description

kauedesousa

4623509

CI Passed

Files		•	•	•	Coverage
R	+109	+48	ø	+61	^-7.02% 68.31%
Project Totals (7 files)	486	332	0	154	68.31%

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

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, ]

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		}

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

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		}

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		}

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

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

Compare 4623509 ... +0 ... 7180aee

No flags found

2 Commits

Compare `4623509 ... +0 ... 7180aee`