Skip to content

Commit

Permalink
0.9.6
Browse files Browse the repository at this point in the history
  • Loading branch information
@jinseob2kim
jinseob2kim committed Aug 25, 2020
1 parent 3f76cad commit 77b409b
Show file tree
Hide file tree
Showing 3 changed files with 51 additions and 38 deletions.
6 changes: 3 additions & 3 deletions DESCRIPTION
View file
Original file line number Diff line number Diff line change
@@ -1,7 +1,7 @@
Package: jstable
Title: Create Tables from Different Types of Regression
Version: 0.9.5
Date: 2020-05-06
Version: 0.9.6
Date: 2020-08-25
Authors@R: c(person("Jinseob", "Kim", email = "[email protected]", role = c("aut", "cre"), comment = c(ORCID = "0000-0002-9403-605X")),
person("Zarathu", role = c("cph", "fnd"))
)
Expand All @@ -10,7 +10,7 @@ Depends: R (>= 3.4.0)
License: Apache License 2.0
Encoding: UTF-8
LazyData: true
RoxygenNote: 7.1.0
RoxygenNote: 7.1.1
Imports: geepack, lme4, stats, data.table, labelled, tableone, coxme, survival (>= 3.0.0), survey, methods, dplyr, purrr, magrittr, tibble, car
URL: https://github.com/jinseob2kim/jstable
BugReports: https://github.com/jinseob2kim/jstable/issues
Expand Down
4 changes: 4 additions & 0 deletions NEWS.md
View file
Original file line number Diff line number Diff line change
@@ -1,3 +1,7 @@
# jstable 0.9.6

* Bugfix `LabelepiDisplay`, `LabeljsTable`: label error.

# jstable 0.9.5

* Bugfix `TableSubgroupCox`: error with too large **time_eventrate**
Expand Down
79 changes: 44 additions & 35 deletions R/label.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -74,7 +74,7 @@ mk.lev = function(data){

LabelepiDisplay = function(epiDisplay.obj, label = F, ref){

variable <- level <- val_label <- NULL
lv2 <- variable <- level <- val_label <- NULL

tb.main <- epiDisplay.obj$table
tb.compact <- tb.main[!rownames(tb.main)=="", ]
Expand All @@ -85,14 +85,15 @@ LabelepiDisplay = function(epiDisplay.obj, label = F, ref){

## Var label
tb.rn = gsub(" \\(cont. var.\\)", "", rownames(tb.compact))
rownames(tb.compact) = tb.rn
rownames(tb.compact) <- tb.rn

if (nrow(tb.main) < 2 & label == T){
vname <- strsplit(rownames(tb.compact)[1], ":")[[1]][1]
cond.lv2 <- grepl(":", rownames(tb.compact)[1]) & grepl("vs", rownames(tb.compact)[1])
rownames(tb.compact) <- gsub(vname, ref[variable == vname, var_label][1], rownames(tb.compact))
if (length(ref[variable == vname, level]) == 2){
vll <- ref[variable == vname, c("level", "val_label")]
rownames(tb.compact) <- gsub(paste(vll[2, 1], " vs ", vll[1,1], sep=""), paste(vll[2, 2], " vs ", vll[1,2], sep=""), rownames(tb.compact))
if (cond.lv2){
vll <- ref[variable == vname & level %in% lv2, c("level", "val_label")]
rownames(tb.compact) <- gsub(paste(vll[level == lv2[1], level], " vs ", vll[level == lv2[2], level], sep=""), paste(vll[level == lv2[1], val_label], " vs ", vll[level == lv2[2], val_label], sep=""), rownames(tb.compact))
}
}

Expand All @@ -102,13 +103,15 @@ LabelepiDisplay = function(epiDisplay.obj, label = F, ref){
vl <- lapply(1:length(vn), function(x){tb.rn[vns[x]:(vns[x+1]-1)]})
vl_label <- lapply(vl, function(x){
vname <- strsplit(x[1], ":")[[1]][1]
cond.lv2 <- grepl(":", x[1]) & grepl("vs", x[1])
#x[1] <- gsub(vname, ref[variable == vname, var_label][1], x[1])
if (length(ref[variable == vname, level]) == 2){
vll = ref[variable == vname, c("level", "val_label")]
x <- paste(ref[variable == vname, var_label][1], ": ", vll[2, 2], " vs ", vll[1, 2], sep = "")
if (cond.lv2){
lv2 <- strsplit(strsplit(x[1], ": ")[[1]][[2]], " vs ")[[1]]
vll <- ref[variable == vname & level %in% lv2, c("level", "val_label")]
x <- paste(ref[variable == vname, var_label][1], ": ", vll[level == lv2[1], val_label], " vs ", vll[level == lv2[2], val_label], sep = "")
#x = gsub(paste(vll[2, 1], " vs ", vll[1,1], sep=""), paste(vll[2, 2], " vs ", vll[1,2], sep=""), x)
} else if (ref[variable == vname, class][1] %in% c("factor", "character")){
x[1] <- paste(ref[variable == vname, var_label][1], ": ref.=", ref[variable == vname, val_label][1], sep = "")
x[1] <- paste(ref[variable == vname, var_label][1], ": ref.=", ref[variable == vname & level == strsplit(x[1], "\\.\\=")[[1]][2], val_label], sep = "")
for (k in 2:length(x)){
x[k] <- paste(" ", ref[variable == vname & level == strsplit(x[k], " ")[[1]][2], val_label], sep = "")
}
Expand All @@ -120,24 +123,24 @@ LabelepiDisplay = function(epiDisplay.obj, label = F, ref){
rownames(tb.compact) <- unlist(vl_label)
}

ll = strsplit(epiDisplay.obj$last.lines,"\n")[[1]]
ll.vec = matrix(unlist(lapply(ll,function(x){strsplit(x," = ")})), ncol =2, byrow=T)
ll.mat = matrix(rep("", nrow(ll.vec)* ncol(tb.compact)), nrow = nrow(ll.vec))
ll <- strsplit(epiDisplay.obj$last.lines,"\n")[[1]]
ll.vec <- matrix(unlist(lapply(ll,function(x){strsplit(x," = ")})), ncol =2, byrow=T)
ll.mat <- matrix(rep("", nrow(ll.vec)* ncol(tb.compact)), nrow = nrow(ll.vec))
ll.mat[,1] = ll.vec[,2]
rownames(ll.mat) = ll.vec[,1]
out = rbind(tb.compact, rep("", ncol(tb.compact)), ll.mat)
rownames(ll.mat) <- ll.vec[,1]
out <- rbind(tb.compact, rep("", ncol(tb.compact)), ll.mat)

if (nrow(tb.main) == 2){
out = rbind(tb.compact, ll.mat)
out <- rbind(tb.compact, ll.mat)
}

p.colnum = which(colnames(out) %in% c("P value", "adj. P value", "P(t-test)", "P(Wald's test)"))
p.colnum = p.colnum[length(p.colnum)]
p.colnum <- which(colnames(out) %in% c("P value", "adj. P value", "P(t-test)", "P(Wald's test)"))
p.colnum <- p.colnum[length(p.colnum)]

pn = gsub("< ","", out[, p.colnum])
pn <- gsub("< ","", out[, p.colnum])

colnames(out)[p.colnum] = ifelse(colnames(out)[p.colnum] == "P value", "P value", "adj. P value")
sig = ifelse(as.numeric(pn) <= 0.05, "**", "")
colnames(out)[p.colnum] <- ifelse(colnames(out)[p.colnum] == "P value", "P value", "adj. P value")
sig <- ifelse(as.numeric(pn) <= 0.05, "**", "")
return(cbind(out,sig))
}

Expand All @@ -163,36 +166,42 @@ LabelepiDisplay = function(epiDisplay.obj, label = F, ref){

LabeljsTable = function(obj.table, ref){

variable <- level <- val_label <- NULL
lv2 <- variable <- level <- val_label <- NULL

tb.main <- obj.table
tb.compact <- tb.main

## Var label
tb.rn = rownames(tb.compact)
tb.rn <- rownames(tb.compact)

if (nrow(tb.main) == 1){
vname = strsplit(rownames(tb.compact)[1], ":")[[1]][1]
rownames(tb.compact) = gsub(vname, ref[variable == vname, var_label][1], rownames(tb.compact))
if (length(ref[variable == vname, level]) == 2){
vll = ref[variable == vname, c("level", "val_label")]
rownames(tb.compact) = gsub(paste(vll[2, 1], " vs ", vll[1,1], sep=""), paste(vll[2, 2], " vs ", vll[1,2], sep=""), rownames(tb.compact))

vname <- strsplit(rownames(tb.compact)[1], ":")[[1]][1]
cond.lv2 <- grepl(":", rownames(tb.compact)[1]) & grepl("vs", rownames(tb.compact)[1])
rownames(tb.compact) <- gsub(vname, ref[variable == vname, var_label][1], rownames(tb.compact))
if (cond.lv2){
vll <- ref[variable == vname & level %in% lv2, c("level", "val_label")]
rownames(tb.compact) <- gsub(paste(vll[level == lv2[1], level], " vs ", vll[level == lv2[2], level], sep=""), paste(vll[level == lv2[1], val_label], " vs ", vll[level == lv2[2], val_label], sep=""), rownames(tb.compact))
}

}

if (nrow(tb.main) > 1){
vn = which(substr(tb.rn, 1, 1) != " ")
vns = c(vn, length(tb.rn)+1 )
vl = lapply(1:length(vn), function(x){tb.rn[vns[x]:(vns[x+1]-1)]})
vn <- which(substr(tb.rn, 1, 1) != " ")
vns <- c(vn, length(tb.rn)+1 )
vl <- lapply(1:length(vn), function(x){tb.rn[vns[x]:(vns[x+1]-1)]})
vl_label = lapply(vl, function(x){
vname <- strsplit(x[1], ":")[[1]][1]
x[1] <- gsub(vname, ref[variable == vname, var_label][1], x[1])
if (length(ref[variable == vname, level]) == 2){
vll = ref[variable == vname, c("level", "val_label")]
x <- paste(ref[variable == vname, var_label][1], ": ", vll[2, 2], " vs ", vll[1, 2], sep = "")
cond.lv2 <- grepl(":", x[1]) & grepl("vs", x[1])
#x[1] <- gsub(vname, ref[variable == vname, var_label][1], x[1])
if (cond.lv2){
lv2 <- strsplit(strsplit(x[1], ": ")[[1]][[2]], " vs ")[[1]]
vll <- ref[variable == vname & level %in% lv2, c("level", "val_label")]
x <- paste(ref[variable == vname, var_label][1], ": ", vll[level == lv2[1], val_label], " vs ", vll[level == lv2[2], val_label], sep = "")
#x = gsub(paste(vll[2, 1], " vs ", vll[1,1], sep=""), paste(vll[2, 2], " vs ", vll[1,2], sep=""), x)
} else if (ref[variable == vname, class][1] %in% c("factor", "character")){
x[1] <- paste(ref[variable == vname, var_label][1], ": ref.=", ref[variable == vname, val_label][1], sep = "")
x[1] <- paste(ref[variable == vname, var_label][1], ": ref.=", ref[variable == vname & level == strsplit(x[1], "\\.\\=")[[1]][2], val_label], sep = "")
for (k in 2:length(x)){
x[k] <- paste(" ", ref[variable == vname & level == strsplit(x[k], " ")[[1]][2], val_label], sep = "")
}
Expand All @@ -204,7 +213,7 @@ LabeljsTable = function(obj.table, ref){
rownames(tb.compact) = unlist(vl_label)
}

out = tb.compact
out <- tb.compact
#sig.colnum = which(colnames(out) %in% c("P value", "adj. P value"))
#pn = gsub("< ","", out[, sig.colnum])
#sig = ifelse(as.numeric(pn) <= 0.05, "**", "")
Expand Down

0 comments on commit 77b409b

Please sign in to comment.