Skip to content

Commit

Permalink
Remove S3 methods from NAMESPACE. Rename package. Add show/summary me…
Browse files Browse the repository at this point in the history 
…thods for NTP
  • Loading branch information
@sciome-bot
sciome-bot committed Jan 24, 2025
1 parent 7ba4f4e commit 4c5d0dd
Show file tree
Hide file tree
Showing 11 changed files with 858 additions and 382 deletions.
2 changes: 1 addition & 1 deletion DESCRIPTION
View file
Original file line number Diff line number Diff line change
@@ -1,4 +1,4 @@
Package: ToxicR
Package: ToxicRToo
Type: Package
Title: Analyzing Toxicology Dose-Response Data
Version: 24.10.1.4
Expand Down
72 changes: 35 additions & 37 deletions NAMESPACE
View file
Original file line number Diff line number Diff line change
@@ -1,4 +1,4 @@
useDynLib(ToxicR, .registration=TRUE)
useDynLib(ToxicRToo, .registration=TRUE)
exportPattern("^[[:alpha:]]+")
importFrom(Rcpp, evalCpp)
importFrom(forcats,fct_reorder)
Expand Down Expand Up @@ -30,59 +30,57 @@ import(ggridges)
#and the plot commands etc.

S3method(print, ntp.polyk, .print_polyk_ntp )
S3method(print, BMD_Bayes_continuous_model, .print.BMD_Bayes_model)
S3method(print, BMD_Bayes_dichotomous_model, .print.BMD_Bayes_model)

# Summary Methods
S3method(summary, BMDcont_fit_maximized ,.summary_continuous_max)
S3method(print,summary_continuous_max ,.print_summary_continuous_max)
S3method(summary, BMDdich_fit_maximized ,.summary_dichotomous_max)
S3method(print,summary_dichotomous_max ,.print_summary_dichotomous_max)

S3method(summary,BMDcont_fit_MCMC , .summary_continuous_mcmc)
S3method(summary,BMDdich_fit_MCMC , .summary_continuous_mcmc)
S3method(print,summary_mcmc , .print_summary_continuous_mcmc)

S3method(summary,BMDcontinuous_MA_laplace , .summary_ma_max)
S3method(summary,BMDcontinuous_MA_mcmc , .summary_ma_mcmc)
S3method(summary,BMDdichotomous_MA_laplace , .summary_ma_max)
S3method(summary,BMDdichotomous_MA_mcmc , .summary_ma_mcmc)
S3method(print,ma_summary_max,.print_summary_ma )
S3method(print,ma_summary_mcmc,.print_summary_ma )

S3method(summary , ntp.shirley, .summary_ntpshirley)
S3method(summary , ntp.williams, .summary_ntpwilliams)
S3method(summary , ntp.dunn, .summary_ntpdunn)
S3method(summary , ntp.dunnett, .summary_ntpdunnett)
# S3method(summary, BMDcont_fit_maximized ,.summary_continuous_max)
# S3method(print,summary_continuous_max ,.print_summary_continuous_max)
# S3method(summary, BMDdich_fit_maximized ,.summary_dichotomous_max)
# S3method(print,summary_dichotomous_max ,.print_summary_dichotomous_max)

# S3method(summary,BMDcont_fit_MCMC , .summary_continuous_mcmc)
# S3method(summary,BMDdich_fit_MCMC , .summary_continuous_mcmc)
# S3method(print,summary_mcmc , .print_summary_continuous_mcmc)

# S3method(summary,BMDcontinuous_MA_laplace , .summary_ma_max)
# S3method(summary,BMDcontinuous_MA_mcmc , .summary_ma_mcmc)
# S3method(summary,BMDdichotomous_MA_laplace , .summary_ma_max)
# S3method(summary,BMDdichotomous_MA_mcmc , .summary_ma_mcmc)
# S3method(print,ma_summary_max,.print_summary_ma )
# S3method(print,ma_summary_mcmc,.print_summary_ma )

# S3method(summary , ntp.shirley, .summary_ntpshirley)
# S3method(summary , ntp.williams, .summary_ntpwilliams)
# S3method(summary , ntp.dunn, .summary_ntpdunn)
# S3method(summary , ntp.dunnett, .summary_ntpdunnett)
#Predict Methods

S3method(predict,BMDdich_fit_maximized, .dichotomous_predict_model)
S3method(predict,BMDcont_fit_maximized, .continuous_predict_model)
S3method(predict,BMDcont_fit_MCMC, .continuous_predict_model_mcmc)
S3method(predict,BMDdich_fit_MCMC, .dichotomous_predict_model_mcmc)
# S3method(predict,BMDdich_fit_maximized, .dichotomous_predict_model)
# S3method(predict,BMDcont_fit_maximized, .continuous_predict_model)
# S3method(predict,BMDcont_fit_MCMC, .continuous_predict_model_mcmc)
# S3method(predict,BMDdich_fit_MCMC, .dichotomous_predict_model_mcmc)


# Base plot for single case

S3method(plot, BMDdich_fit_MCMC, .plot.BMDdich_fit_MCMC)
S3method(plot, BMDdich_fit_maximized, .plot.BMDdich_fit_maximized)
# S3method(plot, BMDdich_fit_MCMC, .plot.BMDdich_fit_MCMC)
# S3method(plot, BMDdich_fit_maximized, .plot.BMDdich_fit_maximized)

# Base plot for single case

S3method(plot, BMDcont_fit_MCMC, .plot.BMDcont_fit_MCMC)
S3method(plot, BMDcont_fit_maximized, .plot.BMDcont_fit_maximized)
# S3method(plot, BMDcont_fit_MCMC, .plot.BMDcont_fit_MCMC)
# S3method(plot, BMDcont_fit_maximized, .plot.BMDcont_fit_maximized)


# Base plot for MA case
S3method(plot, BMDcontinuous_MA, .plot.BMDcontinuous_MA)
S3method(plot, BMDdichotomous_MA, .plot.BMDdichotomous_MA)
# S3method(plot, BMDcontinuous_MA, .plot.BMDcontinuous_MA)
# S3method(plot, BMDdichotomous_MA, .plot.BMDdichotomous_MA)

S3method(cleveland_plot, BMDdichotomous_MA, .cleveland_plot.BMDdichotomous_MA)
S3method(cleveland_plot, BMDcontinuous_MA, .cleveland_plot.BMDcontinous_MA)
# S3method(cleveland_plot, BMDdichotomous_MA, .cleveland_plot.BMDdichotomous_MA)
# S3method(cleveland_plot, BMDcontinuous_MA, .cleveland_plot.BMDcontinous_MA)


# Model Average plot for MCMC
S3method(MAdensity_plot, BMDdichotomous_MA_mcmc, .plot.density.BMDdichotomous_MA_MCMC)
S3method(MAdensity_plot, BMDcontinuous_MA_mcmc, .plot.density.BMDcontinous_MA_MCMC)
# S3method(MAdensity_plot, BMDdichotomous_MA_mcmc, .plot.density.BMDdichotomous_MA_MCMC)
# S3method(MAdensity_plot, BMDcontinuous_MA_mcmc, .plot.density.BMDcontinous_MA_MCMC)


177 changes: 168 additions & 9 deletions R/NTP.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -375,6 +375,30 @@ ntp_jonckeere <- function(formula, data, dose_name = "dose", pair = "Williams")
return(william_test_data)
}

setClass(
"NtpShirley",
slots = c(
results = "data.frame"
)
)
setClass(
"NtpDunn",
slots = c(
results = "data.frame"
)
)
setClass(
"NtpDunnett",
slots = c(
results = "data.frame"
)
)
setClass(
"NtpWilliams",
slots = c(
results = "data.frame"
)
)
## ----------------------
## WILLIAM'S TEST
## ----------------------
Expand Down Expand Up @@ -679,8 +703,7 @@ ntp_williams <- function(formula, data, dose_name = "dose") {
will_results2 <- will_results2[, t_idx]
}

class(will_results2) <- "ntp.williams"
return(will_results2)
new("NtpWilliams", results = will_results2)
}

## ------------------------
Expand Down Expand Up @@ -907,8 +930,7 @@ ntp_dunn <- function(formula, data, dose_name = "dose") {
dunn_results <- dunn_results[, c(dose_idx, remain_idx, test_idx, p_value_idx)]
dunn_results <- dunn_results[, -which(names_to_drop %in% c("rank.mean", temp, "DUNSIGN", "num"))]
}
class(dunn_results) <- "ntp.dunn"
return(dunn_results)
new("NtpDunn", results = dunn_results)
}

## ------------------------
Expand Down Expand Up @@ -1022,8 +1044,7 @@ ntp_dunnett <- function(formula, data, dose_name = "dose") {
dunnett_results[, temp_idx3] <- as.numeric(dunnett_results[, temp_idx3])
}
}
class(dunnett_results) <- "ntp.dunnett"
return(dunnett_results)
new("NtpDunnett", results = dunnett_results)
}

## ----------------------
Expand Down Expand Up @@ -1296,9 +1317,7 @@ ntp_shirley <- function(formula, data, dose_name = "dose") {
shirley_results[is.na(shirley_results)] <- ""
}

class(shirley_results) <- "ntp.shirley"

return(shirley_results)
new("NtpShirley", results = shirley_results)
}

.summary_ntpwilliams <- function(object, ...) {
Expand All @@ -1316,6 +1335,39 @@ ntp_shirley <- function(formula, data, dose_name = "dose") {

print(output, row.names = F)
}
setMethod(
"summary",
signature = "NtpWilliams",
definition = function(object) {
df <- object@results
cat("Williams Trend Test: Monotone Change from Control?\n")
cat("--------------------------------------------------\n")
if (is.null(df) || nrow(df)==0) {
cat("No results.\n")
return(invisible(object))
}
loc <- which(names(df) %in% c("willStat","mult_comp_signif","mult_comp_test"))
if (length(loc)>0) df2 <- df[,-loc,drop=FALSE] else df2 <- df

sign_col <- which(names(df)=="mult_comp_signif")
if (length(sign_col)==0) {
# no significance column, just print
print(df2, row.names=FALSE)
return(invisible(object))
}

data_two <- df[, sign_col]
data_one <- df2

data_a <- rep("No", length(data_two))
data_a[data_two == 1] <- "<0.05"
data_a[data_two == 2] <- "<0.01"
output <- data.frame(data_one, Significant = data_a)
print(output, row.names = FALSE)

invisible(object)
}
)

.summary_ntpdunn <- function(object, ...) {
class(object) <- "data.frame"
Expand All @@ -1337,6 +1389,42 @@ ntp_shirley <- function(formula, data, dose_name = "dose") {
print(output, row.names = FALSE)
}

setMethod(
"summary",
signature = "NtpDunn",
definition = function(object) {
df <- object@results
cat("Dunn Trend Test: Significant Change from Control?\n")
cat("------------------------------------------------\n")

if (is.null(df) || nrow(df) == 0) {
cat("No results.\n")
return(invisible(object))
}

# replicate .summary_ntpdunn:
loc <- which(names(df) == "TEST")
if (length(loc) > 0) df <- df[,-loc,drop=FALSE]

pv_loc <- which(names(df) == "pvalue")
if (length(pv_loc)==0) {
print(df, row.names=FALSE)
return(invisible(object))
}

data_two <- df[, pv_loc]
data_one <- df[, -pv_loc, drop=FALSE]

data_a <- rep("No", length(data_two))
data_a[data_two < 0.05] <- "<0.05"
data_a[data_two < 0.01] <- "<0.01"
output <- data.frame(data_one, Significant = data_a)
print(output, row.names = FALSE)

invisible(object)
}
)

.summary_ntpdunnett <- function(object, ...) {
class(object) <- "data.frame"
loc <- which(names(object) %in% c("TEST", "tstat", "mult_comp_test", "tstat", "mult_comp_signif"))
Expand All @@ -1357,6 +1445,40 @@ ntp_shirley <- function(formula, data, dose_name = "dose") {
print(output, row.names = FALSE)
}

setMethod(
"summary",
signature = "NtpDunnett",
definition = function(object) {
df <- object@results
cat("Dunnett Trend Test: Significant Change from control?\n")
cat("------------------------------------------------\n")

if (is.null(df) || nrow(df)==0) {
cat("No results.\n")
return(invisible(object))
}

loc <- which(names(df) %in% c("TEST", "tstat", "mult_comp_test","mult_comp_signif"))
if (length(loc)>0) df <- df[, -loc, drop=FALSE]

pv_loc <- which(names(df) == "pvalue")
if (length(pv_loc)==0) {
print(df, row.names=FALSE)
return(invisible(object))
}
data_two <- df[, pv_loc]
data_one <- df[, -pv_loc, drop=FALSE]

data_a <- rep("No", length(data_two))
data_a[data_two < 0.10] <- "<0.10"
data_a[data_two < 0.05] <- "<0.05"
data_a[data_two < 0.01] <- "<0.01"

output <- data.frame(data_one, Significant = data_a)
print(output, row.names=FALSE)
invisible(object)
}
)
.summary_ntpshirley <- function(object, ...) {
class(object) <- "data.frame"
loc <- which(names(object) %in% c("testStats", "mult_comp_test"))
Expand All @@ -1375,3 +1497,40 @@ ntp_shirley <- function(formula, data, dose_name = "dose") {
names(output) <- c(names(data_one), "Significant")
print(output, row.names = FALSE)
}

setMethod(
"summary",
signature = "NtpShirley",
definition = function(object) {
df <- object@results
cat("Shirley's Trend Test: Monotone Change from Control?\n")
cat("---------------------------------------------------\n")

if (is.null(df) || nrow(df) == 0) {
cat("No results.\n")
return(invisible(object))
}

loc <- which(names(df) %in% c("testStats", "mult_comp_test"))
if (length(loc) > 0) {
df <- df[, -loc, drop=FALSE]
}
pv_loc <- which(names(df) == "mult_comp_signif")
if (length(pv_loc) == 0) {
# maybe no significance column
print(df, row.names=FALSE)
return(invisible(object))
}

data_two <- df[, pv_loc]
data_one <- df[, -pv_loc, drop=FALSE]

data_a <- rep("No", length(data_two))
data_a[data_two == 1] <- "<0.05"
data_a[data_two == 2] <- "<0.01"
output <- data.frame(data_one, Significant = data_a)
print(output, row.names = FALSE)

invisible(object)
}
)
Loading

0 comments on commit 4c5d0dd

Please sign in to comment.