Skip to content

Commit

Permalink
clean up code
Browse files Browse the repository at this point in the history
  • Loading branch information
@tfrescino
tfrescino committed Aug 12, 2024
1 parent 5dc8c4c commit 635b93b
Show file tree
Hide file tree
Showing 5 changed files with 82 additions and 77 deletions.
2 changes: 1 addition & 1 deletion R/GBest.pbar.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -23,7 +23,7 @@ GBest.pbar <- function(sumyn="CONDPROP_ADJ", ysum, sumyd=NULL, esttype="AREA",
## dhat.var - variance of estimated proportion, for denominator
## covar - covariance of numerator and denominator
########################################################################################
strunitvars <- c(unitvar, strvar)
strunitvars <- c(unitvars, strvar)

if ("data.table" %in% class(stratalut)) {
stratalut <- setDT(stratalut)
Expand Down
124 changes: 62 additions & 62 deletions R/checks.R
View file
Original file line number Diff line number Diff line change
@@ -1,5 +1,5 @@
## check.numeric
# RtoSQL Convert logical R statement syntax to SQL syntax
## RtoSQL Convert logical R statement syntax to SQL syntax
## check.logic
## check.matchclass
## check.matchval
Expand Down Expand Up @@ -58,17 +58,17 @@ RtoSQL <- function(filter, x=NULL) {
if (not) {
part <- gsub("!", "", part)
if (grepl("%in%c", gsub(" ", "", part), ignore.case=TRUE)) {
part <- gsub("%in%c", " not in", gsub(" ", "", part))
part <- gsub("%in%c", " NOT IN", gsub(" ", "", part))
} else if (grepl("%in%", gsub(" ", "", part), ignore.case=TRUE)) {
stop("invalid statement")
part <- gsub("%in%", " not in", gsub(" ", "", part))
part <- gsub("%in%", " NOT IN", gsub(" ", "", part))
}
} else {
if (grepl("%in%c", gsub(" ", "", part), ignore.case=TRUE)) {
part <- gsub("%in%c", " in", gsub(" ", "", part))
part <- gsub("%in%c", " IN", gsub(" ", "", part))
} else if (grepl("%in%", gsub(" ", "", part), ignore.case=TRUE)) {
stop("invalid statement")
part <- gsub("%in%", " in", gsub(" ", "", part))
part <- gsub("%in%", " IN", gsub(" ", "", part))
}
if (grepl(":", part)) {
p1 <- strsplit(part, ":")[[1]][1]
Expand All @@ -88,20 +88,20 @@ RtoSQL <- function(filter, x=NULL) {
post <- ifelse (is.na(strsplit(basetmp, "\\)")[[1]][2]), "", strsplit(basetmp, "\\)")[[1]][2])

if (not) {
part <- paste0(pre, base, " is not NULL", post)
part <- paste0(pre, base, " IS NOT NULL", post)
part <- gsub("!", "", part)
} else {
part <- paste0(pre, base, " is NULL", post)
part <- paste0(pre, base, " IS NULL", post)
}
}

return(part)
}

if (grepl("&", filter)) {
sql <- paste(sapply(unlist(strsplit(filter, "&")), checkpart), collapse = " and ")
sql <- paste(sapply(unlist(strsplit(filter, "&")), checkpart), collapse = " AND ")
} else if (grepl("\\|", filter)) {
sql <- paste(sapply(unlist(strsplit(sql, "\\|")), checkpart), collapse = " or ")
sql <- paste(sapply(unlist(strsplit(sql, "\\|")), checkpart), collapse = " OR ")
} else {
sql <- checkpart(filter)
}
Expand Down Expand Up @@ -212,22 +212,22 @@ check.logic <- function(x, statement, filternm=NULL, stopifnull=FALSE,
## Define function to remove odd parentheses
remove.paren <- function(x) {
x <- gsub(" ", "", x)
leftp <- sum(as.vector(gregexpr("\\(", x)[[1]]) > 0)
rightp <- sum(as.vector(gregexpr("\\)", x)[[1]])> 0)
if (leftp > rightp) {
x <- sub("\\(", "", x)
} else if (rightp > leftp) {
x <- sub("\\)", "", x)
leftp <- sum(as.vector(gregexpr("\\(", x)[[1]]) > 0)
rightp <- sum(as.vector(gregexpr("\\)", x)[[1]])> 0)
if (leftp > rightp) {
x <- sub("\\(", "", x)
} else if (rightp > leftp) {
x <- sub("\\)", "", x)
}
return(x)
return(x)
}

## Return NULL if statement is NULL
if (is.null(statement) || statement == "") {
if (stopifnull) {
stop()
} else {
return(NULL)
stop()
} else {
return(NULL)
}
}

Expand Down Expand Up @@ -271,13 +271,13 @@ check.logic <- function(x, statement, filternm=NULL, stopifnull=FALSE,
grept <- Rlogic.chars.diff[unlist(sapply(Rlogic.chars.diff,
function(x, statement){grepl(x, statement, ignore.case=TRUE)}, statement))]

if (length(grept) > 0) {
if (syntax == "SQL") {
message("syntax is R")
statement <- RtoSQL(statement)
}
syntax <- "R"
}
if (length(grept) > 0) {
if (syntax == "SQL") {
message("syntax is R")
statement <- RtoSQL(statement)
}
syntax <- "R"
}
if (grepl("&", statement, ignore.case=TRUE) || grepl("\\|", statement, ignore.case=TRUE)) {
syntax <- "R"
} else if (grepl(" and ", statement, ignore.case=TRUE) || grepl(" or ", statement, ignore.case=TRUE)) {
Expand All @@ -290,7 +290,7 @@ check.logic <- function(x, statement, filternm=NULL, stopifnull=FALSE,
} else if (syntax == "SQL") {
logic.chars <- SQLlogic.chars
}
if (syntax == "R") {
if (syntax == "R") {
# if (grepl("==", statement) && sum(gregexpr(equalsign, statement)>0) == 0) {
# message("must be R syntax.. changing = to ==")
# statement <- gsub("=", "==", statement)
Expand All @@ -301,37 +301,37 @@ check.logic <- function(x, statement, filternm=NULL, stopifnull=FALSE,
if (grepl("\\|\\|", statement)) {
statement <- gsub("\\|\\|", "\\|", statement)
}
}
}

## Check parentheses
paren.left <- sum(attr(gregexpr("\\(", statement)[[1]], "match.length") > 0)
paren.right <- sum(attr(gregexpr("\\)", statement)[[1]], "match.length") > 0)
if (paren.left < paren.right) {
message("invalid logical statement... missing left parenthesis")
if (stopifinvalid) {
message("invalid logical statement... missing left parenthesis")
if (stopifinvalid) {
stop()
} else {
return(NULL)
}
} else {
return(NULL)
}
} else if (paren.left > paren.right) {
message("invalid logical statement... missing right parenthesis")
if (stopifinvalid) {
message("invalid logical statement... missing right parenthesis")
if (stopifinvalid) {
stop("invalid logical statement... missing right parenthesis")
} else {
return(NULL)
}
} else {
return(NULL)
}
}

#statement <- gsub(" ", "", statement)
if (syntax == "R") {
andnm <- "&"
#statement <- gsub(" ", "", statement)
if (syntax == "R") {
andnm <- "&"
ornm <- "\\|"
} else {
} else {
andnm <- "^and$"
ornm <- "^or$"
ornm <- "^or$"
andnm <- ifelse(grepl(" and ", statement), " and ", " AND ")
ornm <- ifelse(grepl(" or ", statement), " or ", " OR ")
}
}

if (grepl(andnm, statement) && grepl(ornm, statement)) {
partsAND <- trimws(unlist(strsplit(statement, andnm)[[1]]))
Expand All @@ -341,10 +341,10 @@ check.logic <- function(x, statement, filternm=NULL, stopifnull=FALSE,
sum(attr(gregexpr("\\)", partsAND)[[1]], "match.length"))) {

## Split AND parts
parts <- unlist(sapply(partsAND, function(x) strsplit(x, ornm)))
parts <- unlist(sapply(partsAND, function(x) strsplit(x, ornm)))

## Remove odd parentheses
parts <- sapply(as.vector(parts), remove.paren)
## Remove odd parentheses
parts <- sapply(as.vector(parts), remove.paren)

## Check if there are any variables in x that match filter
chkparts <- sapply(parts, chkpartnm, x, logic.chars)
Expand All @@ -353,10 +353,10 @@ check.logic <- function(x, statement, filternm=NULL, stopifnull=FALSE,
sum(attr(gregexpr("\\)", partsOR)[[1]], "match.length"))) {

## Split OR parts
parts <- unlist(sapply(partsOR, function(x) strsplit(x, andnm)))
parts <- unlist(sapply(partsOR, function(x) strsplit(x, andnm)))

## Remove odd parentheses
parts <- sapply(as.vector(parts), remove.paren)
## Remove odd parentheses
parts <- sapply(as.vector(parts), remove.paren)

## Check if there are any variables in x that match filter
chkparts <- sapply(parts, chkpartnm, x, logic.chars, returnvar)
Expand All @@ -377,25 +377,25 @@ check.logic <- function(x, statement, filternm=NULL, stopifnull=FALSE,
## Check if there are any variables in x that match filter
chkparts <- sapply(parts, chkpartnm, x, logic.chars, returnvar)

} else {
} else {

chkparts <- chkpartnm(statement, x, logic.chars, returnvar)
}
chkparts <- chkpartnm(statement, x, logic.chars, returnvar)
}

if (is.null(chkparts) || any(sapply(chkparts, is.null))) {
message(fwarning)
if (returnpart) {
if (all(sapply(chkparts, is.null))) {
if (stopifinvalid) {
message(fwarning)
if (returnpart) {
if (all(sapply(chkparts, is.null))) {
if (stopifinvalid) {
stop()
} else {
return(NULL)
}
}
if (sum(sapply(chkparts, is.null)) > 0 && sum(sapply(chkparts, is.null)) < length(chkparts)) {
return(names(chkparts)[!sapply(chkparts, is.null)])
}
}
}
if (sum(sapply(chkparts, is.null)) > 0 && sum(sapply(chkparts, is.null)) < length(chkparts)) {
return(names(chkparts)[!sapply(chkparts, is.null)])
}
}
if (stopifinvalid) {
stop()
} else {
Expand Down
18 changes: 11 additions & 7 deletions R/popTabchk.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -3,6 +3,8 @@
popTabchk <- function(tabnames, tabtext, tabs, tabIDs, dbtablst, dbconn, datindb=FALSE) {
## DESCRIPTION: check name in tabs list

tabnames <- c("pltu", "plotu", "plt", "plot")

tabx=tabnm <- NULL
tabchk <- sapply(tabnames, findnm, names(tabs), returnNULL = TRUE)
tabchk <- tabchk[!sapply(tabchk, is.null)]
Expand All @@ -19,17 +21,19 @@ popTabchk <- function(tabnames, tabtext, tabs, tabIDs, dbtablst, dbconn, datindb

if (!is.null(dbconn)) {
dbtabchk <- sapply(tablst, findnm, dbtablst, returnNULL = TRUE)
dbtabchk <- names(dbtabchk)[!unlist(lapply(dbtabchk, is.null))]
if (all(is.na(dbtabchk))) {
dbtabnmchk <- names(dbtabchk)[!unlist(lapply(dbtabchk, is.null))]
if (all(is.na(dbtabnmchk))) {
message("invalid name for ", tabtext, ": ", tab)
return(0)
} else if (length(dbtabchk) > 1) {
dbtabchk <- dbtabchk[1]
} else if (length(dbtabnmchk) > 1) {
dbtabnmchk <- dbtabnmchk[1]
}
tab <- tabs[[dbtabchk]]
tabid <- tabIDs[[dbtabchk]]

tab <- tabs[[dbtabnmchk]]
tabid <- tabIDs[[dbtabnmchk]]
tabflds <- DBI::dbListFields(dbconn, tab)
tabnm <- tablst[[dbtabchk]]
tabnm <- findnm(tablst[[dbtabnmchk]], dbtablst)

} else {
tabchk1 <- unlist(tabchk)[1]
if (length(tabchk) > 1) {
Expand Down
2 changes: 1 addition & 1 deletion R/query_functions.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -50,7 +50,7 @@ classqry <- function(classcol,
if (NAto0) {
classify2.qry <- paste(" \n WHEN", classcol, "IS NULL THEN '0'")
}
for (i in 1:(length(fromval)-1)) {
for (i in 1:(length(fromval))) {
if (!is.na(fromval[i])) {
classify2.qry <- paste(classify2.qry,
"\n WHEN", classcol, "=", fromval[i], "THEN",
Expand Down
13 changes: 7 additions & 6 deletions R/table_functions.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -143,15 +143,16 @@ add0unit <- function(x, xvar, uniquex, unitvar=NULL, xvar.add0=FALSE,
if (is.null(uniquex2)) stop("must include uniquex2")
if (!"data.table" %in% class(uniquex2)) {
uniquex2 <- setDT(uniquex2)
}
}
byvars <- c(byvars, xvar2)

if (xvar.add0 && xvar2.add0) {
uniquex.exp <- unique(expand.grid(uniquex[[xvar]], uniquex2[[xvar2]],
stringsAsFactors=FALSE))
stringsAsFactors=FALSE))
if (!is.null(unitvar)) {
uniquex.exp <- data.table(uvar=rep(unique(x[[unitvar]]),
each=nrow(uniquex.exp)), uniquex.exp)
uniquex.exp <-
data.table(uvar = rep(unique(x[[unitvar]]),
each = nrow(uniquex.exp)), uniquex.exp)
setnames(uniquex.exp, c(unitvar, xvar, xvar2))
chkvars <- c(unitvar, xvar, xvar2)
} else {
Expand Down Expand Up @@ -295,8 +296,8 @@ add0unit <- function(x, xvar, uniquex, unitvar=NULL, xvar.add0=FALSE,
if (!is.null(unitvar)) {
setnames(x, unitvar, "uvar")
x <- x[uniquex[rep(1:nrow(uniquex), uniqueN(x$uvar)),
c(.SD, list(uvar=rep(unique(x$uvar), each=nrow(uniquex))))],
on=c("uvar", xvar)]
c(.SD, list(uvar=rep(unique(x$uvar), each=nrow(uniquex))))],
on=c("uvar", xvar)]
setnames(x, "uvar", unitvar)
x[is.na(x)] <- 0
} else {
Expand Down

0 comments on commit 635b93b

Please sign in to comment.