Skip to content

Commit

Permalink
Code style
Browse files Browse the repository at this point in the history
  • Loading branch information
@stewid
stewid committed Nov 2, 2019
1 parent b3f92b2 commit f875889
Show file tree
Hide file tree
Showing 2 changed files with 88 additions and 77 deletions.
161 changes: 86 additions & 75 deletions R/trace.R
View file
Original file line number Diff line number Diff line change
@@ -1,4 +1,4 @@
## Copyright 2013-2017 Stefan Widgren and Maria Noremark,
## Copyright 2013-2019 Stefan Widgren and Maria Noremark,
## National Veterinary Institute, Sweden
##
## Licensed under the EUPL, Version 1.1 or - as soon they
Expand Down Expand Up @@ -31,9 +31,9 @@ is_wholenumber <- function(x, tol = .Machine$double.eps^0.5) {

##' Trace Contacts.
##'
##' Contact tracing for a specied node(s) (root) during a specfied time period.
##' The time period is divided into two parts, one for ingoing contacts and one
##' for outgoing contacts.
##' Contact tracing for a specied node(s) (root) during a specfied
##' time period. The time period is divided into two parts, one for
##' ingoing contacts and one for outgoing contacts.
##'
##'
##' The time period used for \code{Trace} can either be specified
Expand Down Expand Up @@ -112,58 +112,54 @@ is_wholenumber <- function(x, tol = .Machine$double.eps^0.5) {
##' }
##' @export
##' @examples
##' \dontrun{
##'
##' ## Load data
##' data(transfers)
##'
##' ## Perform contact tracing using tEnd and days
##' trace.1 <- Trace(movements=transfers,
##' root=2645,
##' tEnd='2005-10-31',
##' days=91)
##' trace_1 <- Trace(movements = transfers,
##' root = 2645,
##' tEnd = "2005-10-31",
##' days = 91)
##'
##' ## Perform contact tracing using inBegin, inEnd
##' ## outBegin and outEnd
##' trace.2 <- Trace(movements=transfers,
##' root=2645,
##' inBegin='2005-08-01',
##' inEnd='2005-10-31',
##' outBegin='2005-08-01',
##' outEnd='2005-10-31')
##' trace_2 <- Trace(movements = transfers,
##' root = 2645,
##' inBegin = "2005-08-01",
##' inEnd = "2005-10-31",
##' outBegin = "2005-08-01",
##' outEnd = "2005-10-31")
##'
##' ## Check that the result is identical
##' identical(trace.1, trace.2)
##' identical(trace_1, trace_2)
##'
##' ## Show result of contact tracing
##' show(trace.1)
##' show(trace_1)
##'
##' ## Create a network summary for all included herds
##' ## First extract all source and destination from the dataset
##' root <- sort(unique(c(transfers$source,
##' transfers$destination)))
##'
##' ## Perform contact tracing using tEnd and days.
##' trace.3 <- Trace(movements=transfers,
##' root=root,
##' tEnd='2005-10-31',
##' days=91)
##' trace_3 <- Trace(movements = transfers,
##' root = root,
##' tEnd = "2005-10-31",
##' days = 91)
##'
##' ## Perform contact tracing using inBegin, inEnd
##' ## outBegin and outEnd
##' trace.4 <- Trace(movements=transfers,
##' root=root,
##' inBegin=rep('2005-08-01', length(root)),
##' inEnd=rep('2005-10-31', length(root)),
##' outBegin=rep('2005-08-01', length(root)),
##' outEnd=rep('2005-10-31', length(root)))
##' trace_4 <- Trace(movements = transfers,
##' root = root,
##' inBegin = rep("2005-08-01", length(root)),
##' inEnd = rep("2005-10-31", length(root)),
##' outBegin=rep("2005-08-01", length(root)),
##' outEnd=rep("2005-10-31", length(root)))
##'
##' ## Check that the result is identical
##' identical(trace.3, trace.4)
##'
##' NetworkSummary(trace.3)
##' }
##' identical(trace_3, trace_4)
##'
##' NetworkSummary(trace_3)
Trace <- function(movements,
root,
tEnd = NULL,
Expand All @@ -175,8 +171,7 @@ Trace <- function(movements,
maxDistance = NULL) {
## Before doing any contact tracing check that arguments are ok
## from various perspectives.
if (any(missing(movements),
missing(root))) {
if (any(missing(movements), missing(root))) {
stop("Missing parameters in call to Trace")
}

Expand Down Expand Up @@ -204,7 +199,8 @@ Trace <- function(movements,
##
## Check movements$destination
##
if (any(is.factor(movements$destination), is.integer(movements$destination))) {
if (any(is.factor(movements$destination),
is.integer(movements$destination))) {
movements$destination <- as.character(movements$destination)
} else if (!is.character(movements$destination)) {
stop("invalid class of column destination in movements")
Expand Down Expand Up @@ -249,7 +245,8 @@ Trace <- function(movements,
}

if ("category" %in% names(movements)) {
if (any(is.factor(movements$category), is.integer(movements$category))) {
if (any(is.factor(movements$category),
is.integer(movements$category))) {
movements$category <- as.character(movements$category)
} else if (!is.character(movements$category)) {
stop("invalid class of column category in movements")
Expand Down Expand Up @@ -282,8 +279,9 @@ Trace <- function(movements,
if (any(is.factor(root), is.integer(root))) {
root <- as.character(root)
} else if (is.numeric(root)) {
## root is supposed to be a character or integer identifier
## so test that root is a integer the same way as binom.test test x
## root is supposed to be a character or integer identifier so
## test that root is a integer the same way as binom.test test
## x
rootr <- round(root)
if (any(max(abs(root - rootr) > 1e-07))) {
stop("'root' must be an integer or character")
Expand All @@ -301,10 +299,12 @@ Trace <- function(movements,
## Check if we are using the combination of tEnd and days or
## specify inBegin, inEnd, outBegin and outEnd
if (all(!is.null(tEnd), !is.null(days))) {
## Using tEnd and days...check that
## inBegin, inEnd, outBegin and outEnd is NULL
if (!all(is.null(inBegin), is.null(inEnd), is.null(outBegin), is.null(outEnd))) {
stop("Use either tEnd and days or inBegin, inEnd, outBegin and outEnd in call to Trace")
## Using tEnd and days...check that inBegin, inEnd, outBegin
## and outEnd is NULL
if (!all(is.null(inBegin), is.null(inEnd),
is.null(outBegin), is.null(outEnd))) {
stop("Use either tEnd and days or inBegin, inEnd, ",
"outBegin and outEnd in call to Trace")
}

if (any(is.character(tEnd), is.factor(tEnd))) {
Expand All @@ -315,7 +315,8 @@ Trace <- function(movements,
stop("'tEnd' must be a Date vector")
}

## Test that days is a nonnegative integer the same way as binom.test test x
## Test that days is a nonnegative integer the same way as
## binom.test test x
daysr <- round(days)
if (any(is.na(days) | (days < 0)) || max(abs(days - daysr)) > 1e-07) {
stop("'days' must be nonnegative and integer")
Expand All @@ -327,25 +328,27 @@ Trace <- function(movements,
tEnd <- unique(tEnd)
days <- unique(days)

n.root <- length(root)
n.tEnd <- length(tEnd)
n.days <- length(days)
n <- n.root * n.tEnd * n.days
n_root <- length(root)
n_tEnd <- length(tEnd)
n_days <- length(days)
n <- n_root * n_tEnd * n_days

root <- rep(root, each=n.tEnd*n.days, length.out=n)
inEnd <- rep(tEnd, each=n.days, length.out=n)
inBegin <- inEnd - rep(days, each=1, length.out=n)
root <- rep(root, each = n_tEnd * n_days, length.out = n)
inEnd <- rep(tEnd, each = n_days, length.out = n)
inBegin <- inEnd - rep(days, each = 1, length.out = n)
outEnd <- inEnd
outBegin <- inBegin
} else if (all(!is.null(inBegin), !is.null(inEnd), !is.null(outBegin), !is.null(outEnd))) {
## Using tEnd and days...check that
## Using inBegin, inEnd, outBegin and outEnd...check that
## tEnd and days are NULL
} else if (all(!is.null(inBegin), !is.null(inEnd),
!is.null(outBegin), !is.null(outEnd))) {
## Using tEnd and days...check that Using inBegin, inEnd,
## outBegin and outEnd...check that tEnd and days are NULL
if (!all(is.null(tEnd), is.null(days))) {
stop("Use either tEnd and days or inBegin, inEnd, outBegin and outEnd in call to Trace")
stop("Use either tEnd and days or inBegin, inEnd, ",
"outBegin and outEnd in call to Trace")
}
} else {
stop("Use either tEnd and days or inBegin, inEnd, outBegin and outEnd in call to Trace")
stop("Use either tEnd and days or inBegin, inEnd, ",
"outBegin and outEnd in call to Trace")
}

##
Expand Down Expand Up @@ -455,10 +458,13 @@ Trace <- function(movements,


trace_contacts <- .Call("traceContacts",
as.integer(factor(movements$source, levels = levels(nodes))),
as.integer(factor(movements$destination, levels = levels(nodes))),
as.integer(factor(movements$source,
levels = levels(nodes))),
as.integer(factor(movements$destination,
levels = levels(nodes))),
as.integer(julian(movements$t)),
as.integer(factor(root, levels = levels(nodes))),
as.integer(factor(root,
levels = levels(nodes))),
as.integer(julian(inBegin)),
as.integer(julian(inEnd)),
as.integer(julian(outBegin)),
Expand All @@ -468,7 +474,7 @@ Trace <- function(movements,
PACKAGE = "EpiContactTrace")

result <- lapply(seq_len(length(root)), function(i) {
j <- (i-1) * 4
j <- (i - 1) * 4

## Extract data from contact tracing
contacts_all <- movements[trace_contacts[[j + 1]], ]
Expand All @@ -478,11 +484,12 @@ Trace <- function(movements,
## make sure we have unique contacts
contacts <- unique(contacts_all)

## Create an index to contacts, so that the result matrix can be reconstructed
## from the contacts, combined with index and distance
## contacts_all <- cbind(contacts[index,], distance)
index <- match(apply(contacts_all, 1, function(x) paste(x, collapse="\r")),
apply(contacts, 1, function(x) paste(x, collapse="\r")))
## Create an index to contacts, so that the result matrix can
## be reconstructed from the contacts, combined with index and
## distance contacts_all <- cbind(contacts[index,], distance)
index <- match(
apply(contacts_all, 1, function(x) paste(x, collapse = "\r")),
apply(contacts, 1, function(x) paste(x, collapse = "\r")))

ingoingContacts <- new("Contacts",
root = root[i],
Expand All @@ -502,15 +509,16 @@ Trace <- function(movements,
contacts_all <- movements[trace_contacts[[j + 3]], ]
distance <- trace_contacts[[j + 4]]

## Since the algorithm might visit the same node more than once
## make sure we have unique contacts
## Since the algorithm might visit the same node more than
## once make sure we have unique contacts
contacts <- unique(contacts_all)

## Create an index to contacts, so that the result matrix can be reconstructed
## from the contacts, combined with index and distance
## contacts_all <- cbind(contacts[index,], distance)
index <- match(apply(contacts_all, 1, function(x) paste(x, collapse="\r")),
apply(contacts, 1, function(x) paste(x, collapse="\r")))
## Create an index to contacts, so that the result matrix can
## be reconstructed from the contacts, combined with index and
## distance contacts_all <- cbind(contacts[index,], distance)
index <- match(
apply(contacts_all, 1, function(x) paste(x, collapse = "\r")),
apply(contacts, 1, function(x) paste(x, collapse = "\r")))

outgoingContacts <- new("Contacts",
root = root[i],
Expand All @@ -532,11 +540,14 @@ Trace <- function(movements,
outgoingContacts = outgoingContacts))
})

## Name each list item with ContactTrace objects to the name of the ContactTrace root.
names(result) <- sapply(result, function(listItem) listItem@ingoingContacts@root)
## Name each list item with ContactTrace objects to the name of
## the ContactTrace root.
names(result) <- sapply(result, function(listItem) {
listItem@ingoingContacts@root
})

if (identical(length(result), 1L))
return(result[[1]])

return(result)
result
}
4 changes: 2 additions & 2 deletions R/tree.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -61,7 +61,7 @@ build_tree <- function(network_structure) {
dst <- root
}

stopifnot(length(dst)>0)
stopifnot(length(dst) > 0)
tree_in$parent[tree_in$level == lev
& tree_in$node == src] <- dst[1]
}
Expand Down Expand Up @@ -91,7 +91,7 @@ build_tree <- function(network_structure) {
src <- root
}

stopifnot(length(src)>0)
stopifnot(length(src) > 0)
tree_out$parent[tree_out$level == lev
& tree_out$node == dst] <- src[1]
}
Expand Down

1 comment on commit f875889

@lintr-bot
Copy link

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

R/network-structure.R:135:1: style: Lines should not be more than 80 characters.

​              i <- tmp[seq_len(length(tmp) - 1)] != tmp[seq_len(length(tmp))[-1]]
^~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

R/network-summary.R:262:1: style: functions should have cyclomatic complexity of less than 15, this has 38.

​setMethod("NetworkSummary",
^

R/out-degree.R:119:1: style: Lines should not be more than 80 characters.

​##'     Get the OutDegree for a data.frame with movements, see details and examples.
^~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

R/outgoing-contact-chain.R:67:1: style: Lines should not be more than 80 characters.

​##'     The \code{\link{OutgoingContactChain}} of the root within the time-interval
^~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

R/outgoing-contact-chain.R:77:1: style: Lines should not be more than 80 characters.

​##'     Get the OutgoingContactChain for a data.frame with movements, see examples.
^~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

R/outgoing-contact-chain.R:137:1: style: Lines should not be more than 80 characters.

​                  stop("Unable to determine OutgoingContactChain for ingoing contacts")
^~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

R/plot.R:82:1: style: Lines should not be more than 80 characters.

​              tree$ingoing$bg <- ifelse(tree$ingoing$level > 0, "white", "black")
^~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

R/plot.R:95:1: style: Lines should not be more than 80 characters.

​              tree$outgoing$bg <- ifelse(tree$outgoing$level > 0, "gray", "black")
^~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

R/report.R:74:1: style: Lines should not be more than 80 characters.

​    as.character(unlist(by(contacts, sprintf("%s - %s", contacts$lhs, contacts$rhs), function(x) {
^~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

R/report.R:79:1: style: Lines should not be more than 80 characters.

​                   sprintf('<h3><a name="%s-%s-%s">%s %s %s</a></h3>', direction,
^~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

R/report.R:82:1: style: Lines should not be more than 80 characters.

​                   "<tr><th>Date</th><th>Id</th><th>N</th><th>Category</th><th>Source</th><th>Destination</th></tr>")
^~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

R/report.R:142:1: style: Lines should not be more than 80 characters.

​        lines <- c(lines, "<p>No ingoing contacts during the search period.</p>")
^~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

R/report.R:276:1: style: Lines should not be more than 80 characters.

​##' @param template the Sweave template file to use. If none is provided, the default
^~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

R/report.R:369:38: style: Put spaces around all infix operators.

​              Sweave(template, syntax="SweaveSyntaxNoweb")
                                    ~^~

R/shortest-paths.R:168:1: style: functions should have cyclomatic complexity of less than 15, this has 41.

​setMethod("ShortestPaths",
^

R/shortest-paths.R:239:1: style: Lines should not be more than 80 characters.

​              if (!all(is.null(inBegin), is.null(inEnd), is.null(outBegin), is.null(outEnd))) {
^~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

R/shortest-paths.R:240:1: style: Lines should not be more than 80 characters.

​                  stop("Use either tEnd and days or inBegin, inEnd, outBegin and outEnd in call to ShortestPaths")
^~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

R/shortest-paths.R:254:1: style: Lines should not be more than 80 characters.

​              if (any(is.na(days) | (days < 0)) || max(abs(days - daysr)) > 1e-07) {
^~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

R/shortest-paths.R:274:1: style: Lines should not be more than 80 characters.

​          } else if (all(!is.null(inBegin), !is.null(inEnd), !is.null(outBegin), !is.null(outEnd))) {
^~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

R/shortest-paths.R:279:1: style: Lines should not be more than 80 characters.

​                  stop("Use either tEnd and days or inBegin, inEnd, outBegin and outEnd in call to ShortestPaths")
^~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

R/shortest-paths.R:282:1: style: Lines should not be more than 80 characters.

​              stop("Use either tEnd and days or inBegin, inEnd, outBegin and outEnd in call to ShortestPaths")
^~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

R/shortest-paths.R:365:1: style: Lines should not be more than 80 characters.

​              stop("root, inBegin, inEnd, outBegin and outEnd must have equal length")
^~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

R/shortest-paths.R:411:1: style: Lines should not be more than 80 characters.

​                                         destination = x$destination[sp$outRowid],
^~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

R/trace.R:163:1: style: functions should have cyclomatic complexity of less than 15, this has 56.

​Trace <- function(movements,
^

R/tree.R:135:1: style: functions should have cyclomatic complexity of less than 15, this has 48.

​position_tree <- function(tree,
^

Please sign in to comment.