diff --git a/CHANGELOG.md b/CHANGELOG.md deleted file mode 100644 index d01b9a1..0000000 --- a/CHANGELOG.md +++ /dev/null @@ -1,16 +0,0 @@ -# Changes - -## Version 22.04 (1.0.1) - -The following bug fixes are in version 1.0.1: - - - Function `single_continuous_fit' fixed prior issue with Log-Normal data, when sufficient statistics are given. - - Log-Normal deviance for Exponential 3/5 was producing incorrect values. Now reporting - correct values. -The following changes to fitting were made: - - Changed the profile likelihood stopping criteria for profile likelihood equality constrained optimization to be 1e-5. -The following additional functionality was added: - - - - Added summary/print functions for Single Continuous and Single Dichotomous Models. - diff --git a/DESCRIPTION b/DESCRIPTION index 59c0944..8ffae6a 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,24 +1,25 @@ Package: ToxicR Type: Package -Title: This package is for analyzing toxicology dose-response data. -Version: 22.01 -Date: 2022-1-31 +Title: Analyzing Toxicology Dose-Response Data in R +Version: 22.5 +Date: 2022-05-31 Author: NIEHS-BCBB Maintainer: Matt Wheeler -Description: This package provides standard toxicology routines for analyzing +Description: Standard toxicology routines for analyzing dose-response data, which include: dose-response analysis, trend tests, - and Bayesian sensitivity analyses. + and Bayesian sensitivity analyses. For more information, + go to the website . Depends: R (>= 4.1.0) -License: MIT +License: MIT + file LICENSE LazyData: true -Imports: Rcpp (>= 1.0.0), ggplot2 (>= 3.3.2), shiny (>= 1.5.0), plotly (>= 4.9.2.1), +Imports: Rcpp (>= 1.0.0), ggplot2 (>= 3.3.2), shiny (>= 1.5.0), coda (>= 0.19-4), scales (>= 1.1.1), tidyverse (>= 1.3.0), forcats, ggridges (>= 0.5.3), doBy (>= 4.6.11), - modules , multcomp (>= 1.4), VIM (>= 6.1.1), gridExtra (>= 2.3), knitr (>= 1.36), - dplyr (>= 1.0.7), ggpubr (>= 0.4.0), bibtex (>= 0.4.2.3), testthat (>= 3.1.0), actuar (>= 3.2-0) -Include: RcppEigen, RcppGSL + multcomp (>= 1.4), dplyr (>= 1.0.7) LinkingTo: Rcpp, RcppEigen, RcppGSL RoxygenNote: 7.1.2 VignetteBuilder: knitr Suggests: - rmarkdown + rmarkdown, actuar (>= 3.2-0),ggpubr (>= 0.4.0), testthat (>= 3.1.0),gridExtra (>= 2.3), + VIM (>= 6.1.1), knitr (>= 1.36), modules, plotly (>= 4.9.2.1) + diff --git a/LICENSE b/LICENSE index 8661421..6b4dde3 100644 --- a/LICENSE +++ b/LICENSE @@ -1,6 +1,4 @@ -MIT License - -Copyright (c) 2022 Matthew Wheeler +Copyright (c) 2022 Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal diff --git a/NAMESPACE b/NAMESPACE index 0e73425..5a46318 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -7,13 +7,20 @@ importFrom(forcats,fct_reorder) # Necessary Packages ############################### import(tidyverse) -#importFrom(doBy, summaryBy) -import(doBy) + +importFrom(doBy, summaryBy) +#import(doBy) import(multcomp) import(shiny) import(scales) import(ggplot2) -import(dplyr) +importFrom(dplyr,"filter","%>%","select","mutate") + + + +importFrom("stats", "aov", "as.formula", "coefficients", "cor.test", + "density", "lm", "pchisq", "pgamma", "pnorm", "qnorm", + "quantile", "sd", "splinefun", "var") # Added two additional package 2012/12/08 SL import(ggridges) @@ -22,10 +29,10 @@ import(ggridges) #register all of the S3 methods for the print commands #and the plot commands etc. -S3method(print, BMD_Bayes_dichotomous_model, .print.BMD_Bayes_model) -S3method(print, BMD_Bayes_continuous_model, .print.BMD_Bayes_model) -S3method(print, BMD_CDF, .print.BMD_CDF) -S3method(print, BMDdich_fit, .print.BMDdich_fit) +#S3method(print, BMD_Bayes_dichotomous_model, .print.BMD_Bayes_model) +#S3method(print, BMD_Bayes_continuous_model, .print.BMD_Bayes_model) +#S3method(print, BMD_CDF, .print.BMD_CDF) +#S3method(print, BMDdich_fit, .print.BMDdich_fit) # Summary Methods S3method(summary, BMDcont_fit_maximized ,.summary_continuous_max) @@ -33,6 +40,26 @@ 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,BMDdichotomous_MA_laplace , .summary_ma_max) +S3method(print,ma_summary_max,.print_summary_ma_max ) + +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) + + # Base plot for single case S3method(plot, BMDdich_fit_MCMC, .plot.BMDdich_fit_MCMC) diff --git a/R/Build_Priors.R b/R/Build_Priors.R index f451aff..6df314e 100644 --- a/R/Build_Priors.R +++ b/R/Build_Priors.R @@ -17,7 +17,7 @@ #CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE #OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. -parse_prior<-function(prior){ +.parse_prior<-function(prior){ rV <-list() rV$prior <- prior$prior @@ -33,6 +33,23 @@ parse_prior<-function(prior){ } +#' @title create_continuous_prior Given priorlist, a model, +#' and a distribution. Create a prior for a given analysis. +#' @param prior_list First Prior +#' @param model Model to be used +#' @param distribution - Normal "normal", Normal non-constant variance "normal-ncv", or +#' log-normal "lognormal" +#' @param deg - For polynomial models only, the degree of the polynomial. +#' @return new BMDprior list. +#' +#' @examples +#' plist<- create_prior_list(normprior(0,0.1,-100,100), # a +#' normprior(0,1, -1e2,1e2), # b +#' lnormprior(1,0.2,0,18), #k +#' normprior(0,1,-18,18)) +#' +#' power_normal <- create_continuous_prior(plist,"power","normal") +#' create_continuous_prior <- function( prior_list,model,distribution,deg=2){ if (class(prior_list) != "BMDmodelprior"){ @@ -376,6 +393,19 @@ create_continuous_prior <- function( prior_list,model,distribution,deg=2){ return(prior) } + +#' @title create_dichotomous_prior Given priorlist, a model, +#' and a distribution. Create a prior for a given analysis. +#' @param prior First Prior +#' @param model Model to be used should be one of"hill","gamma","logistic","log-logistic","log-probit","multistage", "probit", "qlinear", or "weibull" +#' @return new BMDprior list that can be used in a dichotomous fit. +#' +#' @examples +#' plist<- create_prior_list(normprior(0,0.1,-100,100), # a +#' lnormprior(1,0.2,0,18)) +#' +#' power_normal <- create_dichotomous_prior(plist,"logistic") +#' create_dichotomous_prior <- function(prior,model){ if (class(prior) != "BMDmodelprior"){ diff --git a/R/MAdensity_plot.R b/R/MAdensity_plot.R index f5e41b1..067c777 100644 --- a/R/MAdensity_plot.R +++ b/R/MAdensity_plot.R @@ -5,20 +5,24 @@ #' @param A the model averaged model to plot #' @examples #' \dontrun{ -#' model <- ma_continuous_fit(doses,y,model_list=model_list, +#' doses <- cbind(c(0,25,50,100,200)) +#' y <- cbind(c(6,5.2,2.4,1.1,0.75), +#' c(20,20,19,20,20), +#' c(1.2,1.1,0.81,0.74,0.66)) +#' model <- ma_continuous_fit(doses,y, #' fit_type = "mcmc",BMD_TYPE = 'sd',BMR = 1) #' MAdensity_plot(model) #' } #' @export -MAdensity_plot <- function (A, ...){ +MAdensity_plot <- function (A){ #source("dicho_functions.R") UseMethod("MAdensity_plot") } # Sample Dichotomous Data set - .plot.density.BMDdichotomous_MA_MCMC<-function(A){ # Construct bmd sample plots for mcmc + X1 <- X2 <- X3 <- NULL class_list <- names(A) fit_idx <- grep("Individual_Model",class_list) qprob=0.05 @@ -257,7 +261,7 @@ MAdensity_plot <- function (A, ...){ # No we don't need this part .plot.density.BMDdichotomous_MA_maximized<-function(A){ - + t_1 <- t_2 <- t_3 <- t_4 <- t_5 <- t_6 <- t_7 <- t_8 <- t_9 <- c3 <- X1 <- X2 <- X3 <- NULL class_list <- names(A) if (class(A)[2]=="BMDdichotomous_MA_maximized"){ @@ -384,6 +388,7 @@ MAdensity_plot <- function (A, ...){ .plot.density.BMDcontinous_MA_MCMC<-function(A){ # Construct bmd sample plots for mcmc + X1 <- X2 <- X3 <- NULL class_list <- names(A) fit_idx <- grep("Individual_Model",class_list) qprob=0.05 @@ -406,23 +411,23 @@ MAdensity_plot <- function (A, ...){ if (fit$model=="hill"){ - Q <- apply(fit$mcmc_result$PARM_samples,1,cont_hill_f, d=test_doses) + Q <- apply(fit$mcmc_result$PARM_samples,1,.cont_hill_f, d=test_doses) } if (fit$model=="exp-3"){ - Q <- apply(fit$mcmc_result$PARM_samples,1,cont_exp_3_f, d=test_doses) + Q <- apply(fit$mcmc_result$PARM_samples,1,.cont_exp_3_f, d=test_doses) } if (fit$model=="exp-5"){ - Q <- apply(fit$mcmc_result$PARM_samples,1,cont_exp_5_f, d=test_doses) + Q <- apply(fit$mcmc_result$PARM_samples,1,.cont_exp_5_f, d=test_doses) } if (fit$model=="power"){ - Q <- apply(fit$mcmc_result$PARM_samples,1,cont_power_f, d=test_doses) + Q <- apply(fit$mcmc_result$PARM_samples,1,.cont_power_f, d=test_doses) } if (fit$model=="FUNL"){ - Q <- apply(fit$mcmc_result$PARM_samples,1,cont_FUNL_f, d=test_doses) + Q <- apply(fit$mcmc_result$PARM_samples,1,.cont_FUNL_f, d=test_doses) } diff --git a/R/NTP.R b/R/NTP.R index f97f2c7..542dc3b 100644 --- a/R/NTP.R +++ b/R/NTP.R @@ -17,7 +17,92 @@ #CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE #OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. -polyk <- function(dose,tumor,daysOnStudy){ + +#' 733 unique dose-response datasets +#' +#' A dataset containing 733 dichotomous dose-response studies that were involved in +#' regulatory risk assessment. +#' +#' @format A data frame with 2727 rows and 11 variables: +#' \describe{ +#' \item{ID}{-The study ID in the database.} +#' \item{chemical}{-Name of the Chemical in the study.} +#' \item{data.source}{-Source of the risk assessment data.} +#' \item{CASRN}{-Chemical's CASRN} +#' \item{dose}{-Dose spacing of the study using the original study.} +#' \item{r.dose}{-Doses of the experiment relative to 1 being the maximum dose tested.} +#' \item{n}{-Number of animals on test.} +#' \item{obs}{-Number of adverse events.} +#' \item{organ}{-Organ impacted.} +#' \item{effect}{-Type of adverse effect.} +#' \item{study.source}{-Publication related to the experiment.} +#' } +#' More information at: \doi{10.1111/risa.13218} +"dichotomousDR" + +#' Short term terminal body-weight data from NTP Report 599 +#' +#' This dataset contains terminal body-weight data for male and +#' female rats for the technical report TR-599: Sodium Tungstate Dihydrate. +#' +#' @format A data frame with 120 rows and 4 variables: +#' \describe{ +#' \item{Dose_Group}{-The dose group for the observation.} +#' \item{dose}{-The dose in mg/L } +#' \item{sex}{-Animal's Sex} +#' \item{weight}{-Terminal body-weight} +#' } +#' For more information see: \doi{10.22427/NTP-DATA-TR-599} +"ntp_weight_data" + +#' Long term Thyroid Adenoma data from NTP Report 599 +#' +#' This dataset contains Thyroid Adenoma data for +#' female rats for the technical report TR-599: Sodium Tungstate Dihydrate. +#' +#' @format A data frame with 200 rows and 4 variables: +#' \describe{ +#' \item{treatment}{-The dose group for the observation.} +#' \item{days_on_study}{-Number of days on the study 730 is the max.} +#' \item{adenoma}{- Thyroid Adenoma (Yes/No) (1/0).} +#' \item{dose}{-The dose in mg/L} +#' } +#' For more information see: \doi{10.22427/NTP-DATA-TR-599} +"ntp_599_female" + +#' Clinical Chemistry data from NTP Report 599 +#' +#' This dataset contains clinical chemistry data for +#' all rats in the short term 90-day study. +#' +#' @format A data frame with 200 rows and 4 variables: +#' \describe{ +#' \item{concentration}{-The dose group for the observation.} +#' \item{sex}{- Male/Female.} +#' \item{response}{- Response variable} +#' \item{response_type}{- The type of response measured} +#' } +#' For more information see: \doi{10.22427/NTP-DATA-TR-599} +"ntp_599_hemotology" + +## ---------------------- +## POLYK-TEST +## ---------------------- +#' @title Poly-k trend test +#' This function implements the NTP's polyK trend test. +#' @param dose An equation of the form \eqn{Y \sim X.} Here the variable +#' \eqn{Y} is the response of interest, and \eqn{X} represents discrete experimental +#' conditions. For example, if weight is the dependent variable, and you are +#' interested in looking at the trend across sex one would have 'weight ~ sex'. +#' @param tumor A data frame with column names in the formula. +#' @param daysOnStudy The name of the variable containing the doses in the data frame \eqn{data}. +#' It is expected multiple doses for each of the experimental conditions \eqn{X}. +#' @return The results of a Williams trend test for each level in dose_name. +#' More information on this procedure at: \doi{10.2307/2531856} and \doi{10.2307/2532200} + +#' @examples +#' ntp_polyk(ntp_599_female$dose,ntp_599_female$adenoma,ntp_599_female$days_on_study) +ntp_polyk <- function(dose,tumor,daysOnStudy){ if ( sum(tumor>1) > 0){ stop("Tumors need to be a 0 or 1") } @@ -36,6 +121,7 @@ polyk <- function(dose,tumor,daysOnStudy){ stop("There is an NA in the data.") } result <- .polykCPP(dose,tumor,daysOnStudy) + message("The results of the Poly-K test for trend.\n") cat(sprintf("Poly-1.5 P-value = %1.4f\n",result[1])) cat(sprintf("Poly-3 P-value = %1.4f\n",result[2])) @@ -44,6 +130,7 @@ polyk <- function(dose,tumor,daysOnStudy){ row.names(result)<-c("Poly 1.5","Poly-3", "Poly-6") return(result) } + ## ----------------------------------------------------------- ## JONCKHEERE'S TEST ## ----------------Changelog---------------------------------- @@ -55,6 +142,21 @@ polyk <- function(dose,tumor,daysOnStudy){ ## formula. To do this, we assume that data is a data frame. ## As a default, "dose_name", is set to the column header "dose" ## ----------------------------------------------------------- +#' @title ntp_jonckeere +#' Jonckherre's test for significant differences from background dose +#' @param formula An equation of the form \eqn{Y \sim X.} Here the variable +#' \eqn{Y} is the response of interest, and \eqn{X} represents discrete experimental +#' conditions. For example, if weight is the dependent variable, and you are +#' interested in looking at the trend across sex one would have 'weight ~ sex'. +#' @param data A data frame with column names in the formula. +#' @param dose_name The name of the variable containing the doses in the data frame \eqn{data}. +#' It is expected multiple doses for each of the experimental conditions \eqn{X}. +#' @param pair The type of test used for pairwise comparison. It can either be +#' "Williams" or "Shirley" +#' @return The results of a global test for difference from background. +#' @examples +#' +#' ntp_jonckeere(response ~ sex + response_type,data=ntp_599_hemotology,dose_name="concentration") ntp_jonckeere <- function(formula, data, dose_name="dose", pair = 'Williams' ) { if (!is.data.frame(data)){ @@ -141,7 +243,7 @@ ntp_jonckeere <- function(formula, data, dose_name="dose", pair = 'Williams' ) } .compute_crit_williams <- function(william_test_data,dose_name,formulaV){ - + dof <- NULL t_idx = which(colnames(william_test_data) == dose_name) william_test_data[,t_idx] = as.numeric(william_test_data[,t_idx]) @@ -151,20 +253,20 @@ ntp_jonckeere <- function(formula, data, dose_name="dose", pair = 'Williams' ) for(k in 1:nrow(william_test_data)){ ## CONTROL GROUP if(william_test_data[k,t_idx]==0) ## should this be datatemp or datatemp? - { + { rm william_test_data$crit05 <- FALSE william_test_data$crit01 <- FALSE - } else if(william_test_data[k,t_idx] != 0 & (william_test_data$dof[k] %in% will005$dof)){ + } else if(william_test_data[k,t_idx] != 0 & (william_test_data$dof[k] %in% .will005$dof)){ col1 <- paste('w1crit', k, sep='') col5 <- paste('w5crit', k, sep='') adj1 <- paste('w1adj', k, sep='') adj5 <- paste('w5adj', k, sep='') - w1crit <- subset(will005, dof==william_test_data$dof[k])[,c(col1)] - w1adj <- subset(will005, dof==william_test_data$dof[k])[,c(adj1)] - w5crit <- subset(will025, dof==william_test_data$dof[k])[,c(col5)] - w5adj <- subset(will025, dof==william_test_data$dof[k])[,c(adj5)] + w1crit <- subset(.will005, dof==william_test_data$dof[k])[,c(col1)] + w1adj <- subset(.will005, dof==william_test_data$dof[k])[,c(adj1)] + w5crit <- subset(.will025, dof==william_test_data$dof[k])[,c(col5)] + w5adj <- subset(.will025, dof==william_test_data$dof[k])[,c(adj5)] dofactor <- ((william_test_data$dof[k] - lowdof) / (highdof - lowdof)) temp_name <- sprintf("%s.length",formulaV) @@ -176,7 +278,7 @@ ntp_jonckeere <- function(formula, data, dose_name="dose", pair = 'Williams' ) william_test_data$crit01[k] <- w1crit - (.1 * w1adj * (1 - (trt_num / con_num))) william_test_data$crit05[k] <- w5crit - (.1 * w5adj * (1 - (trt_num / con_num))) - } else if(william_test_data[k,t_idx] != 0 & !(william_test_data$dof[k] %in% will005$dof)) + } else if(william_test_data[k,t_idx] != 0 & !(william_test_data$dof[k] %in% .will005$dof)) { col1 <- paste('w1crit', k, sep='') col5 <- paste('w5crit', k, sep='') @@ -184,20 +286,20 @@ ntp_jonckeere <- function(formula, data, dose_name="dose", pair = 'Williams' ) adj5 <- paste('w5adj', k, sep='') ## get lower bound from table - lowdof <- max(will005$dof[william_test_data$dof[k] > will005$dof]) + lowdof <- max(.will005$dof[william_test_data$dof[k] > .will005$dof]) - low.w1crit <- subset(will005, dof==lowdof)[,c(col1)] - low.w1adj <- subset(will005, dof==lowdof)[,c(adj1)] - low.w5crit <- subset(will025, dof==lowdof)[,c(col5)] - low.w5adj <- subset(will025, dof==lowdof)[,c(adj5)] + low.w1crit <- subset(.will005, dof==lowdof)[,c(col1)] + low.w1adj <- subset(.will005, dof==lowdof)[,c(adj1)] + low.w5crit <- subset(.will025, dof==lowdof)[,c(col5)] + low.w5adj <- subset(.will025, dof==lowdof)[,c(adj5)] ## get upper bound from table - highdof <- min(will005$dof[william_test_data$dof[k] < will005$dof]) + highdof <- min(.will005$dof[william_test_data$dof[k] < .will005$dof]) - high.w1crit <- subset(will005, dof==highdof)[,c(col1)] - high.w1adj <- subset(will005, dof==highdof)[,c(adj1)] - high.w5crit <- subset(will025, dof==highdof)[,c(col5)] - high.w5adj <- subset(will025, dof==highdof)[,c(adj5)] + high.w1crit <- subset(.will005, dof==highdof)[,c(col1)] + high.w1adj <- subset(.will005, dof==highdof)[,c(adj1)] + high.w5crit <- subset(.will025, dof==highdof)[,c(col5)] + high.w5adj <- subset(.will025, dof==highdof)[,c(adj5)] dofactor <- ((william_test_data$dof[k] - lowdof) / (highdof - lowdof)) temp_name <- sprintf("%s.length",formulaV) @@ -217,26 +319,30 @@ ntp_jonckeere <- function(formula, data, dose_name="dose", pair = 'Williams' ) ## WILLIAM'S TEST ## ---------------------- #' Williams Trend test for -#' -#' @param formula An 'R' of the form \code{Y ~ X.} Here the variable -#' \{Y} is the response of interest, and \{X} represents discrete experimental +#' @title Wiliam's trend test +#' @param formula An equation of the form \eqn{Y \sim X.} Here the variable +#' \eqn{Y} is the response of interest, and \eqn{X} represents discrete experimental #' conditions. For example, if weight is the dependent variable, and you are #' interested in looking at the trend across sex one would have 'weight ~ sex'. #' @param data A data frame with column names in the formula. -#' @param dose_name The name of the variable containing the doses in the data frame \code{data}. -#' It is expected multiple doses for each of the experimental conditions \{X}. -#' @return The results of a Williams trend test for each level in \code{dose_name}. +#' @param dose_name The name of the variable containing the doses in the data frame \eqn{data}. +#' It is expected multiple doses for each of the experimental conditions \eqn{X}. +#' @return The results of a Williams trend test for each level in \eqn{dose_name}. +#' For more information on the Williams trend test: \doi{10.2307/2528930} #' @examples -#' add(1, 1) -#' add(10, 1) +#' +#' a = ntp_williams(weight ~ sex, data=ntp_weight_data) +#' summary(a) ntp_williams <- function(formula, data,dose_name = "dose") { - - data[,c(dose_name)] = as.numeric(data[,c(dose_name)]) + + mult_comp_test <- NULL + data[,c(dose_name)] = as.numeric(unlist(data[,c(dose_name)])) + temp_str = strsplit(as.character(formula)[3], " ")[[1]] temp_str = temp_str[temp_str != "+"] data = data[order(data[,c(dose_name)]),] - + for (ii in 1:length(temp_str)){ data = data[order(data[,temp_str[ii]]),] } @@ -244,19 +350,21 @@ ntp_williams <- function(formula, data,dose_name = "dose") if (!(dose_name %in% colnames(data))){ stop(sprintf("Dose name %s does not appear in the data frame.",dose_name)) } - + jonck_data = ntp_jonckeere( formula,dose_name = dose_name, data = data, pair = "Williams") - + ## loop through all groups flagged as WILLIAM in jonck william <- subset(jonck_data, mult_comp_test=='WILLIAMS') will_results <- NULL will_results2 <- NULL + temp_resp_name <- unlist(formula[[2]]) + temp_colnames <- unlist(c(unlist(colnames(william)),dose_name,as.character(unlist(formula[[2]])))) temp <- colnames(data) %in% temp_colnames temp_d <- as.data.frame(data[,temp==TRUE]) - + if(nrow(william) > 0){ for(w in 1:nrow(william)){ @@ -516,16 +624,32 @@ ntp_williams <- function(formula, data,dose_name = "dose") will_results2 = will_results2[,t_idx] } - + + class(will_results2) <- "ntp.williams" return(will_results2) } ##------------------------ ## DUNN'S TEST ##------------------------ -dunn <- function(formula,data, dose_name = "dose") +#' @title ntp_dunn Dunn's test +#' @param formula An equation of the form \eqn{Y \sim X.} Here the variable +#' \eqn{Y} is the response of interest, and \eqn{X} represents discrete experimental +#' conditions. For example, if weight is the dependent variable, and you are +#' interested in looking at the trend across sex one would have 'weight ~ sex'. +#' @param data A data frame with column names in the formula. +#' @param dose_name The name of the variable containing the doses in the data frame \eqn{data}. +#' It is expected multiple doses for each of the experimental conditions \eqn{X}. +#' @return The results of a Dunn's test for each level in \eqn{dose_name}. +#' @examples +#' +#' a = ntp_dunn(response ~ sex + response_type,data=ntp_599_hemotology, +#' dose_name="concentration") +#' summary(a) +ntp_dunn <- function(formula,data, dose_name = "dose") { - data[,c(dose_name)] = as.numeric(data[,c(dose_name)]) + mult_comp_test <- numTies <- NULL + data[,c(dose_name)] = as.numeric(unlist(data[,c(dose_name)])) temp_str = strsplit(as.character(formula)[3], " ")[[1]] temp_str = temp_str[temp_str != "+"] data = data[order(data[,c(dose_name)]),] @@ -544,11 +668,13 @@ dunn <- function(formula,data, dose_name = "dose") dunn <- subset(jonck_data, mult_comp_test=='DUNN') dunn_results <- NULL - + temp_colnames <- unlist(c(unlist(colnames(dunn)),dose_name,as.character(unlist(formula[[2]])))) temp <- colnames(data) %in% temp_colnames temp_d <- as.data.frame(data[,temp==TRUE]) - + if (nrow(dunn)==0){ + warning("The Jonckherre test did not suggest the test be performed. Returning a NULL dataset.") + } ## loop through all groups flagged as DUNN in jonck if(nrow(dunn) > 0){ @@ -738,7 +864,7 @@ 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) } @@ -746,9 +872,21 @@ dunn <- function(formula,data, dose_name = "dose") ##------------------------ ## DUNNETT'S TEST ##------------------------ -dunnett <- function(formula, data,dose_name = "dose"){ - - data[,c(dose_name)] = as.numeric(data[,c(dose_name)]) +#' @title ntp_dunett Dunnett's test +#' @param formula An equation of the form \eqn{Y \sim X.} Here the variable +#' \eqn{Y} is the response of interest, and \eqn{X} represents discrete experimental +#' conditions. For example, if weight is the dependent variable, and you are +#' interested in looking at the trend across sex one would have 'weight ~ sex'. +#' @param data A data frame with column names in the formula. +#' @param dose_name The name of the variable containing the doses in the data frame \eqn{data}. +#' It is expected multiple doses for each of the experimental conditions \eqn{X}. +#' @return The results of Dunnet's test for each level in \eqn{dose_name} +#' @examples +#' a = ntp_dunnett(response ~ sex + response_type,data=ntp_599_hemotology,dose_name="concentration") +#' summary(a) +ntp_dunnett <- function(formula, data,dose_name = "dose"){ + mult_comp_test <- NULL + data[,c(dose_name)] = as.numeric(unlist(data[,c(dose_name)])) temp_str = strsplit(as.character(formula)[3], " ")[[1]] temp_str = temp_str[temp_str != "+"] data = data[order(data[,c(dose_name)]),] @@ -774,6 +912,9 @@ dunnett <- function(formula, data,dose_name = "dose"){ temp <- colnames(data) %in% temp_colnames temp_d <- as.data.frame(data[,temp==TRUE]) + if (nrow(dunnett)==0){ + warning("The Jonckherre test did not suggest the test be performed. Returning a NULL dataset.") + } if(nrow(dunnett) > 0){ for(d in 1:nrow(dunnett)){ @@ -835,16 +976,31 @@ 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) } ## ---------------------- ## SHIRLEY'S TEST ## ---------------------- -shirley <- function(formula, data, dose_name = "dose") +#' @title ntp_shirley Shirley's test as programmed at the NTP +#' @param formula An equation of the form \eqn{Y \sim X.} Here the variable +#' \eqn{Y} is the response of interest, and \eqn{X} represents discrete experimental +#' conditions. For example, if weight is the dependent variable, and you are +#' interested in looking at the trend across sex one would have 'weight ~ sex'. +#' @param data A data frame with column names in the formula. +#' @param dose_name The name of the variable containing the doses in the data frame \eqn{data}. +#' It is expected multiple doses for each of the experimental conditions \eqn{X}. +#' @return The results of a non-parametric Shirley's isotone test for trend on +#' each level in \eqn{dose_name}. For more information see: \doi{10.2307/2529789} +#' +#' @examples +#' a = ntp_shirley(weight ~ sex, data=ntp_weight_data) +#' summary(a) +ntp_shirley <- function(formula, data, dose_name = "dose") { - data[,c(dose_name)] = as.numeric(data[,c(dose_name)]) + mult_comp_test <- numTies <- NULL + data[,c(dose_name)] = as.numeric(unlist(data[,c(dose_name)])) temp_str = strsplit(as.character(formula)[3], " ")[[1]] temp_str = temp_str[temp_str != "+"] data = data[order(data[,c(dose_name)]),] @@ -857,21 +1013,18 @@ shirley <- function(formula, data, dose_name = "dose") stop(sprintf("Dose name %s does not appear in the data frame.",dose_name)) } - ## loop through all groups flagged as SHIRLEY in jonck jonck_data = ntp_jonckeere( formula,dose_name = dose_name, data = data,pair="Shirley") shirley_results <- NULL shirley <- subset(jonck_data, mult_comp_test=='SHIRLEY') - - temp_colnames <- unlist(c(unlist(colnames(shirley)),dose_name,as.character(unlist(formula[[2]])))) temp <- colnames(data) %in% temp_colnames temp_d <- as.data.frame(data[,temp==TRUE]) if(nrow(shirley) > 0) - { + { for(s in 1:nrow(shirley)) { testStats <- NULL @@ -884,7 +1037,7 @@ shirley <- function(formula, data, dose_name = "dose") temp_names[j] <- unlist(shirley[s,j]) } - + ##KRS - changed "phase" to "phasetype" temp_dd <- temp_d temp_dd[is.na(temp_dd)] = '' @@ -905,6 +1058,7 @@ shirley <- function(formula, data, dose_name = "dose") ## make sure there are multiple doses to compare, and control is present if((length(unique(ex[,dose_idx])) > 1) & (0 %in% unique(ex[,dose_idx]))){ exLoop <- ex + for(g in (length(unique(ex[,dose_idx]))-1):1 ){ ## get ties for use in correction formula ties <- as.data.frame(table(table(exLoop[,nval_idx]))) @@ -958,7 +1112,7 @@ shirley <- function(formula, data, dose_name = "dose") } } - + ranks2 <- cbind(ranks, weights) names(ranks2) <- c('value', 'count', 'rank') @@ -1006,7 +1160,7 @@ shirley <- function(formula, data, dose_name = "dose") } T <- shrl_num * (V * (1/Ri + 1/C))^-.5 ## shirlstat in SAS code - + testStats <- c(testStats, T) doseCount <- c(doseCount, g) @@ -1017,17 +1171,22 @@ shirley <- function(formula, data, dose_name = "dose") exLoop <- exLoop[exLoop[,td]!= unique(exLoop[,td])[length(unique(exLoop[,td]))],] ## remove latest dosage before returning to top of loop } - tshirl <- shirley[,-which(colnames(shirley)%in% c("tau","pvalue","mult_comp_test")),drop=F][s,] + + + tshirl <- shirley[,-which(colnames(shirley)%in% c("tau","pvalue","mult_comp_test")),drop=F][s,,drop=F] + results <- as.data.frame(cbind(dose, num, doseCount, testStats)) - + real_temp <- as.data.frame(matrix(NA,nrow=nrow(results),ncol=ncol(tshirl))) + for (ii in 1:ncol(tshirl)){ real_temp[,ii] = tshirl[ii] - } + } + names(real_temp) = colnames(tshirl) results <- cbind(real_temp,results) - + ## add SAS crit values C01 <- c(0, 2.575, 2.607, 2.615, 2.618, 2.620, 2.621, 2.622) C05 <- c(0, 1.96, 2.015, 2.032, 2.040, 2.044, 2.047, 2.0485) @@ -1039,6 +1198,7 @@ shirley <- function(formula, data, dose_name = "dose") ## find crit values, generate number of stars results$mult_comp_signif <- 0 nonsignif_flag <- 'NO' ## to match Laura's version force all doses after first non-signif dose to zero + if(length(doseCount) <= 7){ ## cannot handle more than 7 non control groups ... no crit values to compare to for(i in 1:nrow(results)) { @@ -1077,6 +1237,7 @@ shirley <- function(formula, data, dose_name = "dose") } } ## check for existence + if(!is.null(shirley_results)){ @@ -1093,9 +1254,82 @@ shirley <- function(formula, data, dose_name = "dose") shirley_results[is.na(shirley_results)] <- '' } - + class(shirley_results) <- "ntp.shirley" return(shirley_results) } +.summary_ntpwilliams <- function(object, ...){ + class(object) <- "data.frame" + cat("Williams Trend Test: Monotone Change from control?\n") + cat("--------------------------------------------------\n") + loc <- which(names(object) %in% c("willStat","mult_comp_signif","mult_comp_test") ) + data_one <- object[,-loc] + data_two <- object[,c("mult_comp_signif")] + 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,data_a) + names(output) <- c(names(data_one),"Significant") + + print(output,row.names=F) +} + +.summary_ntpdunn <- function(object, ...){ + class(object) <- "data.frame" + loc <- which(names(object) == "TEST") + object <- object[,-loc] + pv_loc <- which(names(object) == "pvalue") + data_two <- object[,pv_loc] + data_one <- object[,-c(loc,pv_loc)] + + cat("Dunn Trend Test: Significant Change from control? \n") + cat("--------------------------------------------------\n") + + 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,data_a) + names(output) <- c(names(data_one),"Significant") + print(output,row.names=FALSE) +} + +.summary_ntpdunnett <- function(object, ...){ + class(object) <- "data.frame" + loc <- which(names(object) %in% c("TEST","tstat","mult_comp_test","tstat","mult_comp_signif")) + object <- object[,-loc] + pv_loc <- which(names(object) == "pvalue") + data_two <- object[,pv_loc] + data_one <- object[,-c(loc,pv_loc)] + + cat("Dunnett Trend Test: Significant Change from control? \n") + cat("--------------------------------------------------- \n") + + 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,data_a) + names(output) <- c(names(data_one),"Significant") + print(output,row.names=FALSE) +} + +.summary_ntpshirley <- function(object, ...){ + class(object) <- "data.frame" + loc <- which(names(object) %in% c("testStats","mult_comp_test")) + object <- object[,-loc] + pv_loc <- which(names(object) == "mult_comp_signif") + data_two <- object[,pv_loc] + data_one <- object[,-c(loc,pv_loc)] + + cat("Shriley's Trend Test: Monotone Change from control? \n") + cat("--------------------------------------------------- \n") + + 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,data_a) + names(output) <- c(names(data_one),"Significant") + print(output,row.names=FALSE) +} diff --git a/R/RcppExports.R b/R/RcppExports.R index 2267620..f53e42b 100644 --- a/R/RcppExports.R +++ b/R/RcppExports.R @@ -1,31 +1,31 @@ # Generated by using Rcpp::compileAttributes() -> do not edit by hand # Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393 -run_single_dichotomous <- function(model, data, pr, options1, options2) { +.run_single_dichotomous <- function(model, data, pr, options1, options2) { .Call(`_ToxicR_run_single_dichotomous`, model, data, pr, options1, options2) } -run_continuous_single <- function(model, Y, X, prior, options, dist_type) { +.run_continuous_single <- function(model, Y, X, prior, options, dist_type) { .Call(`_ToxicR_run_continuous_single`, model, Y, X, prior, options, dist_type) } -run_continuous_ma_laplace <- function(model_priors, model_type, dist_type, Y, X, options) { +.run_continuous_ma_laplace <- function(model_priors, model_type, dist_type, Y, X, options) { .Call(`_ToxicR_run_continuous_ma_laplace`, model_priors, model_type, dist_type, Y, X, options) } -run_continuous_ma_mcmc <- function(model_priors, model_type, dist_type, Y, X, options) { +.run_continuous_ma_mcmc <- function(model_priors, model_type, dist_type, Y, X, options) { .Call(`_ToxicR_run_continuous_ma_mcmc`, model_priors, model_type, dist_type, Y, X, options) } -run_ma_dichotomous <- function(data, priors, models, model_p, is_MCMC, options1, options2) { +.run_ma_dichotomous <- function(data, priors, models, model_p, is_MCMC, options1, options2) { .Call(`_ToxicR_run_ma_dichotomous`, data, priors, models, model_p, is_MCMC, options1, options2) } -run_dichotomous_single_mcmc <- function(model, Y, D, pr, options) { +.run_dichotomous_single_mcmc <- function(model, Y, D, pr, options) { .Call(`_ToxicR_run_dichotomous_single_mcmc`, model, Y, D, pr, options) } -run_continuous_single_mcmc <- function(model, Y, D, priors, options, is_logNormal, suff_stat) { +.run_continuous_single_mcmc <- function(model, Y, D, priors, options, is_logNormal, suff_stat) { .Call(`_ToxicR_run_continuous_single_mcmc`, model, Y, D, priors, options, is_logNormal, suff_stat) } diff --git a/R/cleveland_plot.R b/R/cleveland_plot.R index 0bd3c83..7f35cc5 100644 --- a/R/cleveland_plot.R +++ b/R/cleveland_plot.R @@ -10,7 +10,7 @@ #' cleveland_plot(model) #' } #' @export -cleveland_plot <- function (A, ...){ +cleveland_plot <- function (A){ UseMethod("cleveland_plot") } @@ -22,12 +22,12 @@ cleveland_plot <- function (A, ...){ # Construct bmd sample plots for mcmc class_list <- names(A) + # Remove "No Visible Bindings Note" + X1 <- X2 <- X3 <-X4 <- X5 <- NULL # This part should be consistent - if (class(A)[2]=="BMDdichotomous_MA_maximized") { - fit_idx<- grep("Fitted_Model",class_list) - }else { - fit_idx<- grep("Individual_Model",class_list) - } + + fit_idx<- grep("Individual_Model",class_list) + # Create an empty matrix to contain BMD information from each model bmd_ind<-matrix(0,length(fit_idx)+1,5) @@ -47,7 +47,7 @@ cleveland_plot <- function (A, ...){ # Ask Matt- For the case of Laplace- bmd object is missing # This part should be consistent - if (class(A)[2]=="BMDdichotomous_MA_mcmc") { + bmd_ind[length(fit_idx)+1,1]<-A$bmd[1] bmd_ind[length(fit_idx)+1,2]<-A$bmd[2] @@ -59,17 +59,6 @@ cleveland_plot <- function (A, ...){ bmd_ind_df<-data.frame(bmd_ind) bmd_ind_df$X1 - }else if (class(A)[2]=="BMDdichotomous_MA_maximized"){ # Need to differentiate the cases- Nearest value index - bmd_ind[length(fit_idx)+1,1]<-A$BMD_CDF[which.min(abs(0.5-A$BMD_CDF[,2])),1] - bmd_ind[length(fit_idx)+1,2]<-A$BMD_CDF[which.min(abs(0.05-A$BMD_CDF[,2])),1] - bmd_ind[length(fit_idx)+1,3]<-A$BMD_CDF[which.min(abs(0.95-A$BMD_CDF[,2])),1] - - bmd_ind[length(fit_idx)+1,4]<-"Model Average" - bmd_ind[length(fit_idx)+1,5]<-1 - - bmd_ind_df<-data.frame(bmd_ind) - bmd_ind_df$X1 - } #Temporarily it choose from CDF case, but this should be updated # @@ -128,7 +117,8 @@ cleveland_plot <- function (A, ...){ .cleveland_plot.BMDcontinous_MA<-function(A){ # Construct bmd sample plots for mcmc class_list <- names(A) - + # Remove "No Visible Bindings Note" + X1 <- X2 <- X3 <-X4 <- X5 <- NULL # Grap function extract # of indices from the text with same pattern fit_idx <- grep("Individual_Model",class_list) diff --git a/R/cont_functions.R b/R/cont_functions.R index 0e54cc4..8675d43 100644 --- a/R/cont_functions.R +++ b/R/cont_functions.R @@ -1,15 +1,16 @@ # Continuous functions are defined here # FUNL -cont_FUNL_f <- function(parms,doses){ +.cont_FUNL_f <- function(parms,doses){ b <- parms[1] + parms[2]*exp((doses-parms[5])^2*(-parms[6]))*(1/(1+exp(-(doses-parms[3])/parms[4]))) return(b) } #dichotomous hill -cont_hill_f <- function(parms,d){ +.cont_hill_f <- function(parms,d){ g <- parms[1] - nu <- parms[2] + nu <- parms[2] + k <- parms[3]; n <- parms[4]; rval <- g + nu*d^n/(k^n+d^n) @@ -17,7 +18,7 @@ cont_hill_f <- function(parms,d){ } #dichotomous log-logistic -cont_exp_5_f <- function(parms,d){ +.cont_exp_5_f <- function(parms,d){ g <- parms[1] b <- parms[2]; c <- parms[3]; @@ -27,7 +28,7 @@ cont_exp_5_f <- function(parms,d){ } #dichotomous log-probit -cont_exp_3_f <-function(parms,d){ +.cont_exp_3_f <-function(parms,d){ g <- parms[1] b <- parms[2] e <- parms[4] @@ -35,7 +36,7 @@ cont_exp_3_f <-function(parms,d){ return (rval) } -cont_power_f <-function(parms,d){ +.cont_power_f <-function(parms,d){ g <- parms[1]; b <- parms[2]; a <- parms[3]; diff --git a/R/continuous_clean.R b/R/continuous_clean.R index 1465e3c..1fd2a18 100644 --- a/R/continuous_clean.R +++ b/R/continuous_clean.R @@ -1,292 +1,292 @@ -############################################################# -# Function: clean_continuous_analysis -# By default a continuous analysis constraints the result -# to be proportional to background mean. This is 'undone' -# in this function so all values are on the origional scale. -# info: the fit information for a continuous model -# log_normal: TRUE if the fit was a lognormal -# dmodel: Fit information type... to be fixed. -############################################################# -clean_continuous_analysis <-function(info,log_normal,dmodel){ - - c("hill","exp-3","exp-5","power") - if (dmodel == 1) #hill - { - if (log_normal){ - DELTA <- diag(c(info$SCALE,info$SCALE,info$dose_scale,1,1)); - info$EST <- DELTA%*%info$EST; - info$COV <- DELTA%*%info$COV%*%t(DELTA) - if (ncol(info$Y)==1){ - info$F_INFO[1] = info$F_INFO[1] - sum(log(1/info$Y)) + sum(log(info$SCALE/info$Y)) - }else{ - - } - }else{ - #rescale the estimates for normality - if (nrow(info$EST)==5) {#constant variance - DELTA <- diag(c(info$SCALE,info$SCALE,info$dose_scale,1,1)); - info$EST <- DELTA%*%info$EST; tmp = info$EST[5] + 2*log(info$SCALE) - info$COV <- DELTA%*%info$COV%*%t(DELTA) - #fix the constant portion of the likelihood - if (ncol(info$Y)==1){ #individual data - info$F_INFO[1] = info$F_INFO[1]+log(exp(0.5*tmp*nrow(info$Y)))-log(exp(0.5*info$EST[5]*nrow(info$Y))) - info$EST[5] = tmp - }else{ #summarized data - - } - }else{ #non-constant variance - DELTA <- diag(c(info$SCALE,info$SCALE,info$dose_scale,1,1,1)); - o_est <- info$EST - info$EST <- DELTA%*%info$EST; - info$COV <- DELTA%*%info$COV%*%t(DELTA) - #fix the constant portion of the likelihood - if (ncol(info$Y)==1){ #individual data - t_est = info$EST - mean_t = t_est[1] + t_est[2]*(info$X^t_est[4])/(t_est[3]^t_est[4]+(info$X[,1])^t_est[4]) - mean_o = o_est[1] + o_est[2]*(info$X/max(info$X[,1]))^o_est[4]/(o_est[3]^o_est[4]+(info$X/max(info$X))^o_est[4]) - var_t = exp(info$EST[6]+(2-info$EST[5])*log(info$SCALE))*mean_t^info$EST[5] - var_o = exp(info$EST[6])*mean_o^info$EST[5] - info$F_INFO[1] = info$F_INFO[1]+sum(0.5*log(var_t))-sum(0.5*log(var_o)) - info$EST[6] = info$EST[6]+(2-info$EST[5])*log(info$SCALE) - }else{ #summarized data - - } - } - } - - } - if (dmodel == 2) #exp-3 - { #lognormality is the easiest - if (log_normal){ - DELTA <- diag(c(info$SCALE,(1/info$dose_scale),1,1)); - info$EST <- DELTA%*%info$EST; - info$COV <- DELTA%*%info$COV%*%t(DELTA) - if (ncol(info$Y)==1){ #individual data - info$F_INFO[1] = info$F_INFO[1] - sum(log(1/info$Y)) + sum(log(info$SCALE/info$Y)) - }else{ - - } - }else{ - #rescale the estimates for normality - if (nrow(info$EST)==4) {#constant variance - DELTA <- diag(c(info$SCALE,(1/info$dose_scale),1,1)); - info$EST <- DELTA%*%info$EST; tmp = info$EST[4] + 2*log(info$SCALE) - info$COV <- DELTA%*%info$COV%*%t(DELTA) - #fix the constant portion of the likelihood - if (ncol(info$Y)==1){ #individual data - info$F_INFO[1] = info$F_INFO[1]+log(exp(0.5*tmp*nrow(info$Y)))-log(exp(0.5*info$EST[4]*nrow(info$Y))) - info$EST[4] = tmp - }else{ #summarized data - - } - }else{ #non-constant variance - DELTA <- diag(c(info$SCALE,(1/info$dose_scale),1,1,1)); - o_est <- info$EST - info$EST <- DELTA%*%info$EST; - info$COV <- DELTA%*%info$COV%*%t(DELTA) - #fix the constant portion of the likelihood - if (ncol(info$Y)==1){ #individual data - t_est = info$EST - mean_t = t_est[1] * exp((t_est[2]*info$Y)^t_est[3]) - mean_o = o_est[1] * exp((o_est[2]*info$Y/max(info$Y))^o_est[3]) - var_t = exp(info$EST[5]+(2-info$EST[4])*log(info$SCALE))*mean_t^info$EST[4] - var_o = exp(info$EST[5])*mean_o^info$EST[4] - info$F_INFO[1] = info$F_INFO[1]+sum(0.5*log(var_t))-sum(0.5*log(var_o)) - info$EST[5] = info$EST[5]+(2-info$EST[4])*log(info$SCALE) - }else{ #summarized data - - } - } - } - - } - if (dmodel == 3) #exp-5 - { - if (log_normal){ - DELTA <- diag(c(info$SCALE,(1/info$dose_scale),1,1,1)); - info$EST <- DELTA%*%info$EST; - info$COV <- DELTA%*%info$COV%*%t(DELTA) - if (ncol(info$Y)==1){ #individual data - info$F_INFO[1] = info$F_INFO[1] - sum(log(1/info$Y)) + sum(log(info$SCALE/info$Y)) - }else{ - - } - } - else{ - #rescale the estimates for normality - if (nrow(EST)==5) {#constant variance - DELTA <- diag(c(info$SCALE,(1/info$dose_scale),1,1,1)); - info$EST <- DELTA%*%info$EST; tmp = info$EST[5] + 2*log(info$SCALE) - info$COV <- DELTA%*%info$COV%*%t(DELTA) - #fix the constant portion of the likelihood - if (ncol(info$Y)==1){ #individual data - info$F_INFO[1] = info$F_INFO[1]+log(exp(0.5*tmp*nrow(info$Y)))-log(exp(0.5*info$EST[5]*nrow(info$Y))) - info$EST[5] = tmp - }else{ #summarized data - - } - }else{ #non-constant variance - DELTA <- diag(c(info$SCALE,(1/info$dose_scale),1,1,1,1)); - o_est <- info$EST - info$EST <- DELTA%*%info$EST; - info$COV <- DELTA%*%info$COV%*%t(DELTA) - #fix the constant portion of the likelihood - if (ncol(info$Y)==1){ #individual data - t_est = info$EST - mean_t = t_est[1] *(exp(t_est[3])-(exp(t_est[3])-1)*exp(-(t_est[2]*info$Y)^t_est[4])) - mean_o = o_est[1] *(exp(o_est[3])-(exp(o_est[3])-1)*exp(-(o_est[2]*info$Y/max(info$Y))^o_est[4])) - var_t = exp(info$EST[6]+(2-info$EST[5])*log(info$SCALE))*mean_t^info$EST[5] - var_o = exp(info$EST[6])*mean_o^info$EST[5] - info$F_INFO[1] = info$F_INFO[1]+sum(0.5*log(var_t))-sum(0.5*log(var_o)) - info$EST[6] = info$EST[6]+(2-info$EST[5])*log(info$SCALE) - }else{ #summarized data - - } - } - } - - } - if (dmodel == 4) #power - { - if (log_normal){ - DELTA <- diag(c(info$SCALE,info$SCALE*(1/info$dose_scale)^(info$EST[3]),1,1)); - info$EST <- DELTA%*%info$EST; - info$COV <- DELTA%*%info$COV%*%t(DELTA) - if (ncol(info$Y)==1){ #individual data - info$F_INFO[1] = info$F_INFO[1] - sum(log(1/info$Y)) + sum(log(info$SCALE/info$Y)) - }else{ - - } - }else{ - #rescale the estimates for normality - if (nrow(info$EST)==4) {#constant variance - DELTA <- diag(c(info$SCALE,info$SCALE*(1/info$dose_scale)^(info$EST[3]),1,1)); - info$EST <- DELTA%*%info$EST; tmp = info$EST[4] + 2*log(info$SCALE) - info$COV <- DELTA%*%info$COV%*%t(DELTA) - #fix the constant portion of the likelihood - if (ncol(info$data)){ #individual data - info$F_INFO[1] = info$F_INFO[1]+log(exp(0.5*tmp*nrow(info$Y)))-log(exp(0.5*info$EST[4]*nrow(info$Y))) - info$EST[4] = tmp - }else{ #summarized data - - } - }else{ #non-constant variance - DELTA <- diag(c(info$SCALE,info$SCALE*(1/info$dose_scale)^(info$EST[3]),1,1,1)); - o_est <- info$EST - info$EST <- DELTA%*%info$EST; - info$COV <- DELTA%*%info$COV%*%t(DELTA) - #fix the constant portion of the likelihood - if (ncol(info$Y)==1){ #individual data - t_est = info$EST - mean_t = t_est[1] + t_est[2]*info$Y^t_est[3] - mean_o = o_est[1] + o_est[2]*(info$Y/max(info$Y))^o_est[3] - var_t = exp(info$EST[5]+(2-info$EST[4])*log(info$SCALE))*mean_t^info$EST[4] - var_o = exp(info$EST[5])*mean_o^info$EST[4] - info$F_INFO[1] = info$F_INFO[1]+sum(0.5*log(var_t))-sum(0.5*log(var_o)) - info$EST[5] = info$EST[5]+(2-info$EST[4])*log(info$SCALE) - }else{ #summarized data - - } - } - } - } - - return(info) -} - -############################################################# -# Function: clean_continuous_analysis -# By default a continuous analysis constraints the result -# to be proportional to background mean. This is 'undone' -# in this function so all values are on the origional scale. -# info: the fit information for a continuous model -# log_normal: TRUE if the fit was a lognormal -# dmodel: Fit information type... to be fixed. -############################################################# -clean_parameters <-function(model,A,B,SCALE,dose_scale,deg,log_normal){ - EST <- A - COV <- B - - dmodel = which(model==c("hill","exp-3","exp-5","power","poly")) - - if (dmodel == 1) #hill - { #rescale the estimates for normality - if (nrow(EST)==5) {#constant variance - DELTA <- diag(c(SCALE,SCALE,dose_scale,1,1)); - EST <- DELTA%*%EST; - if (!log_normal){ - EST[5] = EST[5] + 2*log(SCALE) - } - COV <- DELTA%*%COV%*%t(DELTA) - }else{ #non-constant variance - DELTA <- diag(c(SCALE,SCALE,dose_scale,1,1,1)); - EST <- DELTA%*%EST; - COV <- DELTA%*%COV%*%t(DELTA) - } - } - if (dmodel == 2) #exp-3 - { #lognormality is the easiest - if (nrow(EST)==4) {#constant variance - DELTA <- diag(c(SCALE,(1/dose_scale),1,1)); - EST <- DELTA%*%EST; - if (!log_normal){ - EST[4] = EST[4] + 2*log(SCALE) - } - COV <- DELTA%*%COV%*%t(DELTA) - }else{ #non-constant variance - DELTA <- diag(c(SCALE,(1/dose_scale),1,1,1)); - EST <- DELTA%*%EST; - COV <- DELTA%*%COV%*%t(DELTA) - } - } - if (dmodel == 3) #exp-5 - { - if (nrow(EST)==5) {#constant variance - DELTA <- diag(c(SCALE,(1/dose_scale),1,1,1)); - EST <- DELTA%*%EST; - if (!log_normal){ - EST[5] = EST[5] + 2*log(SCALE) - } - COV <- DELTA%*%COV%*%t(DELTA) - }else{ #non-constant variance - DELTA <- diag(c(SCALE,(1/dose_scale),1,1,1,1)); - EST <- DELTA%*%EST; - COV <- DELTA%*%COV%*%t(DELTA) - } - } - if (dmodel == 4) #power - { - if (nrow(EST) == 4) {#constant variance - DELTA <- diag(c(SCALE,SCALE*(1/dose_scale)^(EST[3]),1,1)); - EST <- DELTA%*%EST; - if (!log_normal){ - EST[4] = EST[4] + 2*log(SCALE) - } - DELTA[3,4] = log(1/dose_scale)*SCALE*(1/dose_scale)^EST[3] #delta method - COV <- DELTA%*%COV%*%t(DELTA) - } else{ #non-constant variance - DELTA <- diag(c(SCALE,SCALE*(1/dose_scale)^(EST[3]),1,1,1)); - EST <- DELTA%*%EST; - DELTA[3,4] = log(1/dose_scale)*SCALE*(1/dose_scale)^EST[3] #delta method - COV <- DELTA%*%COV%*%t(DELTA) - } - } - if (dmodel == 5) #polynomial - { - if (nrow(EST)==deg+2) {#constant variance - DELTA <- diag(c(SCALE,SCALE*(1/dose_scale)^(1:deg),1)); - EST <- DELTA%*%EST; - if (!log_normal){ - EST[4] = EST[4] + 2*log(SCALE) - } - COV <- DELTA%*%COV%*%t(DELTA) - } else{ #non-constant variance - DELTA <- diag(c(SCALE,SCALE*(1/dose_scale)^(1:deg),1,1)); - EST <- DELTA%*%EST; - COV <- DELTA%*%COV%*%t(DELTA) - } - } - rval <- list(EST,COV) - names(rval) <- c("EST","COV") - return(rval) -} +# ############################################################# +# # Function: clean_continuous_analysis +# # By default a continuous analysis constraints the result +# # to be proportional to background mean. This is 'undone' +# # in this function so all values are on the origional scale. +# # info: the fit information for a continuous model +# # log_normal: TRUE if the fit was a lognormal +# # dmodel: Fit information type... to be fixed. +# ############################################################# +# clean_continuous_analysis <-function(info,log_normal,dmodel){ +# +# c("hill","exp-3","exp-5","power") +# if (dmodel == 1) #hill +# { +# if (log_normal){ +# DELTA <- diag(c(info$SCALE,info$SCALE,info$dose_scale,1,1)); +# info$EST <- DELTA%*%info$EST; +# info$COV <- DELTA%*%info$COV%*%t(DELTA) +# if (ncol(info$Y)==1){ +# info$F_INFO[1] = info$F_INFO[1] - sum(log(1/info$Y)) + sum(log(info$SCALE/info$Y)) +# }else{ +# +# } +# }else{ +# #rescale the estimates for normality +# if (nrow(info$EST)==5) {#constant variance +# DELTA <- diag(c(info$SCALE,info$SCALE,info$dose_scale,1,1)); +# info$EST <- DELTA%*%info$EST; tmp = info$EST[5] + 2*log(info$SCALE) +# info$COV <- DELTA%*%info$COV%*%t(DELTA) +# #fix the constant portion of the likelihood +# if (ncol(info$Y)==1){ #individual data +# info$F_INFO[1] = info$F_INFO[1]+log(exp(0.5*tmp*nrow(info$Y)))-log(exp(0.5*info$EST[5]*nrow(info$Y))) +# info$EST[5] = tmp +# }else{ #summarized data +# +# } +# }else{ #non-constant variance +# DELTA <- diag(c(info$SCALE,info$SCALE,info$dose_scale,1,1,1)); +# o_est <- info$EST +# info$EST <- DELTA%*%info$EST; +# info$COV <- DELTA%*%info$COV%*%t(DELTA) +# #fix the constant portion of the likelihood +# if (ncol(info$Y)==1){ #individual data +# t_est = info$EST +# mean_t = t_est[1] + t_est[2]*(info$X^t_est[4])/(t_est[3]^t_est[4]+(info$X[,1])^t_est[4]) +# mean_o = o_est[1] + o_est[2]*(info$X/max(info$X[,1]))^o_est[4]/(o_est[3]^o_est[4]+(info$X/max(info$X))^o_est[4]) +# var_t = exp(info$EST[6]+(2-info$EST[5])*log(info$SCALE))*mean_t^info$EST[5] +# var_o = exp(info$EST[6])*mean_o^info$EST[5] +# info$F_INFO[1] = info$F_INFO[1]+sum(0.5*log(var_t))-sum(0.5*log(var_o)) +# info$EST[6] = info$EST[6]+(2-info$EST[5])*log(info$SCALE) +# }else{ #summarized data +# +# } +# } +# } +# +# } +# if (dmodel == 2) #exp-3 +# { #lognormality is the easiest +# if (log_normal){ +# DELTA <- diag(c(info$SCALE,(1/info$dose_scale),1,1)); +# info$EST <- DELTA%*%info$EST; +# info$COV <- DELTA%*%info$COV%*%t(DELTA) +# if (ncol(info$Y)==1){ #individual data +# info$F_INFO[1] = info$F_INFO[1] - sum(log(1/info$Y)) + sum(log(info$SCALE/info$Y)) +# }else{ +# +# } +# }else{ +# #rescale the estimates for normality +# if (nrow(info$EST)==4) {#constant variance +# DELTA <- diag(c(info$SCALE,(1/info$dose_scale),1,1)); +# info$EST <- DELTA%*%info$EST; tmp = info$EST[4] + 2*log(info$SCALE) +# info$COV <- DELTA%*%info$COV%*%t(DELTA) +# #fix the constant portion of the likelihood +# if (ncol(info$Y)==1){ #individual data +# info$F_INFO[1] = info$F_INFO[1]+log(exp(0.5*tmp*nrow(info$Y)))-log(exp(0.5*info$EST[4]*nrow(info$Y))) +# info$EST[4] = tmp +# }else{ #summarized data +# +# } +# }else{ #non-constant variance +# DELTA <- diag(c(info$SCALE,(1/info$dose_scale),1,1,1)); +# o_est <- info$EST +# info$EST <- DELTA%*%info$EST; +# info$COV <- DELTA%*%info$COV%*%t(DELTA) +# #fix the constant portion of the likelihood +# if (ncol(info$Y)==1){ #individual data +# t_est = info$EST +# mean_t = t_est[1] * exp((t_est[2]*info$Y)^t_est[3]) +# mean_o = o_est[1] * exp((o_est[2]*info$Y/max(info$Y))^o_est[3]) +# var_t = exp(info$EST[5]+(2-info$EST[4])*log(info$SCALE))*mean_t^info$EST[4] +# var_o = exp(info$EST[5])*mean_o^info$EST[4] +# info$F_INFO[1] = info$F_INFO[1]+sum(0.5*log(var_t))-sum(0.5*log(var_o)) +# info$EST[5] = info$EST[5]+(2-info$EST[4])*log(info$SCALE) +# }else{ #summarized data +# +# } +# } +# } +# +# } +# if (dmodel == 3) #exp-5 +# { +# if (log_normal){ +# DELTA <- diag(c(info$SCALE,(1/info$dose_scale),1,1,1)); +# info$EST <- DELTA%*%info$EST; +# info$COV <- DELTA%*%info$COV%*%t(DELTA) +# if (ncol(info$Y)==1){ #individual data +# info$F_INFO[1] = info$F_INFO[1] - sum(log(1/info$Y)) + sum(log(info$SCALE/info$Y)) +# }else{ +# +# } +# } +# else{ +# #rescale the estimates for normality +# if (nrow(EST)==5) {#constant variance +# DELTA <- diag(c(info$SCALE,(1/info$dose_scale),1,1,1)); +# info$EST <- DELTA%*%info$EST; tmp = info$EST[5] + 2*log(info$SCALE) +# info$COV <- DELTA%*%info$COV%*%t(DELTA) +# #fix the constant portion of the likelihood +# if (ncol(info$Y)==1){ #individual data +# info$F_INFO[1] = info$F_INFO[1]+log(exp(0.5*tmp*nrow(info$Y)))-log(exp(0.5*info$EST[5]*nrow(info$Y))) +# info$EST[5] = tmp +# }else{ #summarized data +# +# } +# }else{ #non-constant variance +# DELTA <- diag(c(info$SCALE,(1/info$dose_scale),1,1,1,1)); +# o_est <- info$EST +# info$EST <- DELTA%*%info$EST; +# info$COV <- DELTA%*%info$COV%*%t(DELTA) +# #fix the constant portion of the likelihood +# if (ncol(info$Y)==1){ #individual data +# t_est = info$EST +# mean_t = t_est[1] *(exp(t_est[3])-(exp(t_est[3])-1)*exp(-(t_est[2]*info$Y)^t_est[4])) +# mean_o = o_est[1] *(exp(o_est[3])-(exp(o_est[3])-1)*exp(-(o_est[2]*info$Y/max(info$Y))^o_est[4])) +# var_t = exp(info$EST[6]+(2-info$EST[5])*log(info$SCALE))*mean_t^info$EST[5] +# var_o = exp(info$EST[6])*mean_o^info$EST[5] +# info$F_INFO[1] = info$F_INFO[1]+sum(0.5*log(var_t))-sum(0.5*log(var_o)) +# info$EST[6] = info$EST[6]+(2-info$EST[5])*log(info$SCALE) +# }else{ #summarized data +# +# } +# } +# } +# +# } +# if (dmodel == 4) #power +# { +# if (log_normal){ +# DELTA <- diag(c(info$SCALE,info$SCALE*(1/info$dose_scale)^(info$EST[3]),1,1)); +# info$EST <- DELTA%*%info$EST; +# info$COV <- DELTA%*%info$COV%*%t(DELTA) +# if (ncol(info$Y)==1){ #individual data +# info$F_INFO[1] = info$F_INFO[1] - sum(log(1/info$Y)) + sum(log(info$SCALE/info$Y)) +# }else{ +# +# } +# }else{ +# #rescale the estimates for normality +# if (nrow(info$EST)==4) {#constant variance +# DELTA <- diag(c(info$SCALE,info$SCALE*(1/info$dose_scale)^(info$EST[3]),1,1)); +# info$EST <- DELTA%*%info$EST; tmp = info$EST[4] + 2*log(info$SCALE) +# info$COV <- DELTA%*%info$COV%*%t(DELTA) +# #fix the constant portion of the likelihood +# if (ncol(info$data)){ #individual data +# info$F_INFO[1] = info$F_INFO[1]+log(exp(0.5*tmp*nrow(info$Y)))-log(exp(0.5*info$EST[4]*nrow(info$Y))) +# info$EST[4] = tmp +# }else{ #summarized data +# +# } +# }else{ #non-constant variance +# DELTA <- diag(c(info$SCALE,info$SCALE*(1/info$dose_scale)^(info$EST[3]),1,1,1)); +# o_est <- info$EST +# info$EST <- DELTA%*%info$EST; +# info$COV <- DELTA%*%info$COV%*%t(DELTA) +# #fix the constant portion of the likelihood +# if (ncol(info$Y)==1){ #individual data +# t_est = info$EST +# mean_t = t_est[1] + t_est[2]*info$Y^t_est[3] +# mean_o = o_est[1] + o_est[2]*(info$Y/max(info$Y))^o_est[3] +# var_t = exp(info$EST[5]+(2-info$EST[4])*log(info$SCALE))*mean_t^info$EST[4] +# var_o = exp(info$EST[5])*mean_o^info$EST[4] +# info$F_INFO[1] = info$F_INFO[1]+sum(0.5*log(var_t))-sum(0.5*log(var_o)) +# info$EST[5] = info$EST[5]+(2-info$EST[4])*log(info$SCALE) +# }else{ #summarized data +# +# } +# } +# } +# } +# +# return(info) +# } +# +# ############################################################# +# # Function: clean_continuous_analysis +# # By default a continuous analysis constraints the result +# # to be proportional to background mean. This is 'undone' +# # in this function so all values are on the origional scale. +# # info: the fit information for a continuous model +# # log_normal: TRUE if the fit was a lognormal +# # dmodel: Fit information type... to be fixed. +# ############################################################# +# clean_parameters <-function(model,A,B,SCALE,dose_scale,deg,log_normal){ +# EST <- A +# COV <- B +# +# dmodel = which(model==c("hill","exp-3","exp-5","power","poly")) +# +# if (dmodel == 1) #hill +# { #rescale the estimates for normality +# if (nrow(EST)==5) {#constant variance +# DELTA <- diag(c(SCALE,SCALE,dose_scale,1,1)); +# EST <- DELTA%*%EST; +# if (!log_normal){ +# EST[5] = EST[5] + 2*log(SCALE) +# } +# COV <- DELTA%*%COV%*%t(DELTA) +# }else{ #non-constant variance +# DELTA <- diag(c(SCALE,SCALE,dose_scale,1,1,1)); +# EST <- DELTA%*%EST; +# COV <- DELTA%*%COV%*%t(DELTA) +# } +# } +# if (dmodel == 2) #exp-3 +# { #lognormality is the easiest +# if (nrow(EST)==4) {#constant variance +# DELTA <- diag(c(SCALE,(1/dose_scale),1,1)); +# EST <- DELTA%*%EST; +# if (!log_normal){ +# EST[4] = EST[4] + 2*log(SCALE) +# } +# COV <- DELTA%*%COV%*%t(DELTA) +# }else{ #non-constant variance +# DELTA <- diag(c(SCALE,(1/dose_scale),1,1,1)); +# EST <- DELTA%*%EST; +# COV <- DELTA%*%COV%*%t(DELTA) +# } +# } +# if (dmodel == 3) #exp-5 +# { +# if (nrow(EST)==5) {#constant variance +# DELTA <- diag(c(SCALE,(1/dose_scale),1,1,1)); +# EST <- DELTA%*%EST; +# if (!log_normal){ +# EST[5] = EST[5] + 2*log(SCALE) +# } +# COV <- DELTA%*%COV%*%t(DELTA) +# }else{ #non-constant variance +# DELTA <- diag(c(SCALE,(1/dose_scale),1,1,1,1)); +# EST <- DELTA%*%EST; +# COV <- DELTA%*%COV%*%t(DELTA) +# } +# } +# if (dmodel == 4) #power +# { +# if (nrow(EST) == 4) {#constant variance +# DELTA <- diag(c(SCALE,SCALE*(1/dose_scale)^(EST[3]),1,1)); +# EST <- DELTA%*%EST; +# if (!log_normal){ +# EST[4] = EST[4] + 2*log(SCALE) +# } +# DELTA[3,4] = log(1/dose_scale)*SCALE*(1/dose_scale)^EST[3] #delta method +# COV <- DELTA%*%COV%*%t(DELTA) +# } else{ #non-constant variance +# DELTA <- diag(c(SCALE,SCALE*(1/dose_scale)^(EST[3]),1,1,1)); +# EST <- DELTA%*%EST; +# DELTA[3,4] = log(1/dose_scale)*SCALE*(1/dose_scale)^EST[3] #delta method +# COV <- DELTA%*%COV%*%t(DELTA) +# } +# } +# if (dmodel == 5) #polynomial +# { +# if (nrow(EST)==deg+2) {#constant variance +# DELTA <- diag(c(SCALE,SCALE*(1/dose_scale)^(1:deg),1)); +# EST <- DELTA%*%EST; +# if (!log_normal){ +# EST[4] = EST[4] + 2*log(SCALE) +# } +# COV <- DELTA%*%COV%*%t(DELTA) +# } else{ #non-constant variance +# DELTA <- diag(c(SCALE,SCALE*(1/dose_scale)^(1:deg),1,1)); +# EST <- DELTA%*%EST; +# COV <- DELTA%*%COV%*%t(DELTA) +# } +# } +# rval <- list(EST,COV) +# names(rval) <- c("EST","COV") +# return(rval) +# } diff --git a/R/continuous_plots.R b/R/continuous_plots.R index 0e44d95..c0f6f2f 100644 --- a/R/continuous_plots.R +++ b/R/continuous_plots.R @@ -1,5 +1,5 @@ -cont_polynomial_f <- function(A,doses,decrease=F){ +.cont_polynomial_f <- function(A,doses,decrease=F){ B <- as.matrix(A,ncol=1) X <- matrix(1,nrow = length(doses),ncol=length(A)) @@ -10,13 +10,13 @@ cont_polynomial_f <- function(A,doses,decrease=F){ } # FUNL -cont_FUNL_f <- function(A,doses,decrease=F){ +.cont_FUNL_f <- function(A,doses,decrease=F){ b <- A[1] + A[2]*exp(-exp(A[6])*(doses-A[5])^2)*(1/(1+exp(-(doses-A[3])/A[4]))) return(b) } #dichotomous hill -cont_hill_f <- function(parms,d,decrease=F){ +.cont_hill_f <- function(parms,d,decrease=F){ g <- parms[1] nu <- parms[2] k <- parms[3]; @@ -25,7 +25,7 @@ cont_hill_f <- function(parms,d,decrease=F){ return (rval) } #dichotomous log-logistic -cont_exp_5_f <- function(parms,d,decrease=F){ +.cont_exp_5_f <- function(parms,d,decrease=F){ g <- parms[1] b <- parms[2]; c <- parms[3]; @@ -35,7 +35,7 @@ cont_exp_5_f <- function(parms,d,decrease=F){ } # -cont_exp_3_f <-function(parms,d,decrease = TRUE){ +.cont_exp_3_f <-function(parms,d,decrease = TRUE){ if (decrease){ f_sign = -1; }else{ @@ -48,7 +48,7 @@ cont_exp_3_f <-function(parms,d,decrease = TRUE){ return (rval) } -cont_power_f <-function(parms,d,decrease=F){ +.cont_power_f <-function(parms,d,decrease=F){ g <- parms[1]; b <- parms[2]; a <- parms[3]; @@ -56,7 +56,15 @@ cont_power_f <-function(parms,d,decrease=F){ return (rval) } -.plot.BMDcont_fit_MCMC<-function(fit,qprob=0.05,...){ +.plot.BMDcont_fit_MCMC<-function(x,...){ + fit = x + Dose <- NULL + temp_args = list(...) + if (!exists("qprob",temp_args)){ + qprob = 0.05 + }else{ + qprob = temp_args$qprob + } isLogNormal = (grepl("Log-Normal",fit$full_model) == 1) @@ -103,27 +111,27 @@ cont_power_f <-function(parms,d,decrease=F){ } if (fit$model=="FUNL"){ - Q <- apply(fit$mcmc_result$PARM_samples,1,cont_FUNL_f, d=test_doses,decrease=decrease) + Q <- apply(fit$mcmc_result$PARM_samples,1,.cont_FUNL_f, d=test_doses,decrease=decrease) } if (fit$model=="hill"){ - Q <- apply(fit$mcmc_result$PARM_samples,1,cont_hill_f, d=test_doses,decrease=decrease) + Q <- apply(fit$mcmc_result$PARM_samples,1,.cont_hill_f, d=test_doses,decrease=decrease) } if (fit$model=="exp-3"){ - Q <- apply(fit$mcmc_result$PARM_samples,1,cont_exp_3_f, d=test_doses,decrease=decrease) + Q <- apply(fit$mcmc_result$PARM_samples,1,.cont_exp_3_f, d=test_doses,decrease=decrease) if (isLogNormal){ Q <- exp(log(Q)+ exp(fit$mcmc_result$PARM_samples[,ncol(fit$mcmc_result$PARM_samples)])/2) } } if (fit$model=="exp-5"){ - Q <- apply(fit$mcmc_result$PARM_samples,1,cont_exp_5_f, d=test_doses,decrease=decrease) + Q <- apply(fit$mcmc_result$PARM_samples,1,.cont_exp_5_f, d=test_doses,decrease=decrease) if (isLogNormal){ Q <- exp(log(Q)+ exp(fit$mcmc_result$PARM_samples[,ncol(fit$mcmc_result$PARM_samples)])/2) } } if (fit$model=="power"){ - Q <- apply(fit$mcmc_result$PARM_samples,1,cont_power_f, d=test_doses,decrease=decrease) + Q <- apply(fit$mcmc_result$PARM_samples,1,.cont_power_f, d=test_doses,decrease=decrease) } if (fit$model=="polynomial"){ if (length(grep(": normal-ncv", tolower(fit$full_model)))>0){ @@ -131,7 +139,7 @@ cont_power_f <-function(parms,d,decrease=F){ }else{ degree = ncol(fit$mcmc_result$PARM_samples) - 1 } - Q <- apply(fit$mcmc_result$PARM_samples[,1:degree],1,cont_polynomial_f, + Q <- apply(fit$mcmc_result$PARM_samples[,1:degree],1,.cont_polynomial_f, d=test_doses,decrease=decrease) } @@ -206,7 +214,14 @@ cont_power_f <-function(parms,d,decrease=F){ } # This part matches with single_continous_fit part- SL 06/02/21 -.plot.BMDcont_fit_maximized<-function(A,qprob=0.05,...){ +.plot.BMDcont_fit_maximized<-function(x,...){ + A = x + temp_args = list(...) + if (!exists("qprob",temp_args)){ + qprob = 0.05 + }else{ + qprob = temp_args$qprob + } isLogNormal = (grepl("Log-Normal",A$full_model) == 1) IS_tranformed = A$transformed @@ -252,19 +267,19 @@ cont_power_f <-function(parms,d,decrease=F){ } #Pre defined function- lm_fit can be used for fitting parameters? if (fit$model=="FUNL"){ - me <- cont_FUNL_f(fit$parameters,test_doses) + me <- .cont_FUNL_f(fit$parameters,test_doses) } if (fit$model=="hill"){ - me <- cont_hill_f(fit$parameters,test_doses) + me <- .cont_hill_f(fit$parameters,test_doses) } if (fit$model=="exp-3"){ - me <- cont_exp_3_f(fit$parameters,test_doses,decrease) + me <- .cont_exp_3_f(fit$parameters,test_doses,decrease) } if (fit$model=="exp-5"){ - me <- cont_exp_5_f(fit$parameters,test_doses) + me <- .cont_exp_5_f(fit$parameters,test_doses) } if (fit$model=="power"){ - me <- cont_power_f(fit$parameters,test_doses) + me <- .cont_power_f(fit$parameters,test_doses) } if (fit$model=="polynomial"){ if (length(grep(": normal-ncv", tolower(fit$full_model)))>0){ @@ -273,7 +288,7 @@ cont_power_f <-function(parms,d,decrease=F){ degree = length(fit$parameters) - 1 } - me <- cont_polynomial_f(fit$parameters[1:degree],test_doses) + me <- .cont_polynomial_f(fit$parameters[1:degree],test_doses) } if (isLogNormal){ var = exp(fit$parameters[length(fit$parameters)]) @@ -328,8 +343,15 @@ cont_power_f <-function(parms,d,decrease=F){ } # Base plot- MCMC or BMD? -.plot.BMDcontinuous_MA <- function(A,qprob=0.05,...){ - +.plot.BMDcontinuous_MA <- function(x,...){ + A = x + model_no <- x_axis <- y_axis <-cols <- NULL + temp_args = list(...) + if (!exists("qprob",temp_args)){ + qprob = 0.05 + }else{ + qprob = temp_args$qprob + } # Should be matched with BMD_MA plots # SL 06/02 Updated # Later, we'll have it @@ -378,23 +400,23 @@ cont_power_f <-function(parms,d,decrease=F){ for (ii in 1:n_samps){ fit <- A[[fit_idx[ma_samps[ii]]]] if (fit$model=="FUNL"){ - temp_f[ii,] <- cont_FUNL_f(fit$mcmc_result$PARM_samples[ii,],test_doses) + temp_f[ii,] <- .cont_FUNL_f(fit$mcmc_result$PARM_samples[ii,],test_doses) temp_bmd[ii] <- fit$mcmc_result$BMD_samples[ii] } if (fit$model=="hill"){ - temp_f[ii,] <- cont_hill_f(fit$mcmc_result$PARM_samples[ii,],test_doses) + temp_f[ii,] <- .cont_hill_f(fit$mcmc_result$PARM_samples[ii,],test_doses) temp_bmd[ii] <- fit$mcmc_result$BMD_samples[ii] } if (fit$model=="exp-3"){ - temp_f[ii,] <- cont_exp_3_f(fit$mcmc_result$PARM_samples[ii,],test_doses,decrease) + temp_f[ii,] <- .cont_exp_3_f(fit$mcmc_result$PARM_samples[ii,],test_doses,decrease) temp_bmd[ii] <- fit$mcmc_result$BMD_samples[ii] } if (fit$model=="exp-5"){ - temp_f[ii,] <- cont_exp_5_f(fit$mcmc_result$PARM_samples[ii,],test_doses) + temp_f[ii,] <- .cont_exp_5_f(fit$mcmc_result$PARM_samples[ii,],test_doses) temp_bmd[ii] <- fit$mcmc_result$BMD_samples[ii] } if (fit$model=="power"){ - temp_f[ii,] <- cont_power_f(fit$mcmc_result$PARM_samples[ii,],test_doses) + temp_f[ii,] <- .cont_power_f(fit$mcmc_result$PARM_samples[ii,],test_doses) temp_bmd[ii] <- fit$mcmc_result$BMD_samples[ii] } } @@ -480,20 +502,20 @@ cont_power_f <-function(parms,d,decrease=F){ if (A$posterior_probs[ii]>0.05){ fit <- A[[fit_idx[ii]]] if (fit$model=="FUNL"){ - f <- cont_FUNL_f(fit$parameters,test_doses) + f <- .cont_FUNL_f(fit$parameters,test_doses) } if (fit$model=="hill"){ - f <- cont_hill_f(fit$parameters,test_doses) + f <- .cont_hill_f(fit$parameters,test_doses) } if (fit$model=="exp-3"){ temp = fit$parameters - f <- cont_exp_3_f(temp,test_doses,decrease) + f <- .cont_exp_3_f(temp,test_doses,decrease) } if (fit$model=="exp-5"){ - f <- cont_exp_5_f(fit$parameters,test_doses) + f <- .cont_exp_5_f(fit$parameters,test_doses) } if (fit$model=="power"){ - f <- cont_power_f(fit$parameters,test_doses) + f <- .cont_power_f(fit$parameters,test_doses) } col = 'coral3' temp_df<-data.frame(x_axis=test_doses,y_axis=f,cols=col,model_no=ii, alpha_lev=A$posterior_probs[ii]) @@ -561,7 +583,7 @@ cont_power_f <-function(parms,d,decrease=F){ for (ii in 1:length(fit_idx)){ fit <- A[[fit_idx[ii]]] if (fit$model=="FUNL"){ - t <- cont_FUNL_f(fit$parameters,test_doses) + t <- .cont_FUNL_f(fit$parameters,test_doses) if(A$posterior_probs[ii] > 0){ me = t*A$posterior_probs[ii] + me } @@ -569,7 +591,7 @@ cont_power_f <-function(parms,d,decrease=F){ } if (fit$model=="hill"){ - t <- cont_hill_f(fit$parameters,test_doses) + t <- .cont_hill_f(fit$parameters,test_doses) # SL comment - why the name of object is BB? At the beginning it was declared as A- 05/28/21 # I guess this part should be A as well @@ -578,20 +600,20 @@ cont_power_f <-function(parms,d,decrease=F){ } } if (fit$model=="exp-3"){ - t <- cont_exp_3_f(fit$parameters,test_doses,decrease) + t <- .cont_exp_3_f(fit$parameters,test_doses,decrease) if(A$posterior_probs[ii] > 0){ me = t*A$posterior_probs[ii] + me } } if (fit$model=="exp-5"){ - t <- cont_exp_5_f(fit$parameters,test_doses) + t <- .cont_exp_5_f(fit$parameters,test_doses) if(A$posterior_probs[ii] > 0){ me = t*A$posterior_probs[ii] + me } } if (fit$model=="power"){ - t <- cont_power_f(fit$parameters,test_doses) + t <- .cont_power_f(fit$parameters,test_doses) if(A$posterior_probs[ii] > 0){ me = t*A$posterior_probs[ii] + me } @@ -636,20 +658,20 @@ cont_power_f <-function(parms,d,decrease=F){ if (A$posterior_probs[ii]>0.05){ fit <- A[[fit_idx[ii]]] if (fit$model=="FUNL"){ - f <- cont_FUNL_f(fit$parameters,test_doses) + f <- .cont_FUNL_f(fit$parameters,test_doses) } if (fit$model=="hill"){ - f <- cont_hill_f(fit$parameters,test_doses) + f <- .cont_hill_f(fit$parameters,test_doses) } if (fit$model=="exp-3"){ temp = fit$parameters - f <- cont_exp_3_f(temp,test_doses,decrease) + f <- .cont_exp_3_f(temp,test_doses,decrease) } if (fit$model=="exp-5"){ - f <- cont_exp_5_f(fit$parameters,test_doses) + f <- .cont_exp_5_f(fit$parameters,test_doses) } if (fit$model=="power"){ - f <- cont_power_f(fit$parameters,test_doses) + f <- .cont_power_f(fit$parameters,test_doses) } col = 'coral3' @@ -674,7 +696,7 @@ cont_power_f <-function(parms,d,decrease=F){ annotate(geom = "point", x = A$bmd[1], y = ma_mean(A$bmd[1]), size = 5, color="darkslategrey",shape=17, alpha=0.9) } - + return(plot_gg + coord_cartesian(xlim=c(min(test_doses)-width,max(test_doses)+width),expand=F)) } diff --git a/R/continuous_pvalue.R b/R/continuous_pvalue.R index a0e5052..06143f5 100644 --- a/R/continuous_pvalue.R +++ b/R/continuous_pvalue.R @@ -18,7 +18,7 @@ # # ################################################# -crutial_stat_constant <- function(param,y,doses,var,mean_function,decreasing,alpha=0){ +.crutial_stat_constant <- function(param,y,doses,var,mean_function,decreasing,alpha=0){ expected <- mean_function(param,doses,decreasing) sq_resid <- (y-expected)^2/(var*expected^alpha) return(sum(sq_resid)) @@ -31,32 +31,32 @@ crutial_stat_constant <- function(param,y,doses,var,mean_function,decreasing,alp pValue_return = NA; if (model == "FUNL"){ - func = cont_FUNL_f + func = .cont_FUNL_f } if (model == "exp-5"){ - func = cont_exp_5_f + func = .cont_exp_5_f } if (model == "exp-3"){ - func = cont_exp_3_f + func = .cont_exp_3_f } if (model == "hill"){ - func = cont_hill_f + func = .cont_hill_f } if (model == "power"){ - func = cont_power_f + func = .cont_power_f } if (model == "polynomial"){ } if (distribution == "normal"){ - q<- apply(mcmc_fit$mcmc_result$PARM_samples[1000:nrow(mcmc_fit$mcmc_result$PARM_samples),], 1,crutial_stat_constant,y=y, + q<- apply(mcmc_fit$mcmc_result$PARM_samples[1000:nrow(mcmc_fit$mcmc_result$PARM_samples),], 1,.crutial_stat_constant,y=y, doses=doses,var =exp(mcmc_fit$varOpt[1]),mean_function=func,decreasing=decreasing,alpha=0) temp <- pchisq(quantile(q,0.90),length(y)-1) pValue_return = 1 - max(0,(temp*length(q)-0.90*length(q)+1)/(length(q)-0.90*length(q)+1)) } if (distribution == "normal-ncv"){ - q<- apply(mcmc_fit$mcmc_result$PARM_samples[1000:nrow(mcmc_fit$mcmc_result$PARM_samples),], 1,crutial_stat_constant,y=y, + q<- apply(mcmc_fit$mcmc_result$PARM_samples[1000:nrow(mcmc_fit$mcmc_result$PARM_samples),], 1,.crutial_stat_constant,y=y, doses=doses,var =exp(mcmc_fit$varOpt[2]),mean_function=func,decreasing=decreasing,alpha=mcmc_fit$varOpt[3]) temp <- pchisq(quantile(q,0.90),length(y)-1) pValue_return = 1 - max(0,(temp*length(q)-0.90*length(q)+1)/(length(q)-0.90*length(q)+1)) diff --git a/R/continuous_wrappers.R b/R/continuous_wrappers.R index bbdb905..2e93b3d 100644 --- a/R/continuous_wrappers.R +++ b/R/continuous_wrappers.R @@ -24,18 +24,21 @@ #' @title single_continuous_fit - Fit a single continuous BMD model. #' @param D doses matrix #' @param Y response matrix +#' @param model_type Mean model. #' @param fit_type the method used to fit (laplace, mle, or mcmc) +#' @param prior Prior / model for the continuous fit. If this is specified, it overrides the parameters 'model_type' and 'distribution.' #' @param BMD_TYPE BMD_TYPE specifies the type of benchmark dose analysis to be performed. For continuous models, there are four types of BMD definitions that are commonly used. \cr #' - Standard deviation is the default option, but it can be explicitly specified with 'BMR_TYPE = "sd"' This definition defines the BMD as the dose associated with the mean/median changing a specified number of standard deviations from the mean at the control dose., i.e., it is the dose, BMD, that solves \eqn{\mid f(dose)-f(0) \mid = BMR \times \sigma} \cr #' - Relative deviation can be specified with 'BMR_TYPE = "rel"'. This defines the BMD as the dose that changes the control mean/median a certain percentage from the background dose, i.e. it is the dose, BMD that solves \eqn{\mid f(dose) - f(0) \mid = (1 \pm BMR) f(0)} \cr #' - Hybrid deviation can be specified with 'BMR_TYPE = "hybrid"'. This defines the BMD that changes the probability of an adverse event by a stated amount relitive to no exposure (i.e 0). That is, it is the dose, BMD, that solves \eqn{\frac{Pr(X > x| dose) - Pr(X >x|0)}{Pr(X < x|0)} = BMR}. For this definition, \eqn{Pr(X < x|0) = 1 - Pr(X > X|0) = \pi_0}, where \eqn{0 \leq \pi_0 < 1} is defined by the user as "point_p," and it defaults to 0.01. Note: this discussion assumed increasing data. The fitter determines the direction of the data and inverts the probability statements for decreasing data. \cr -#' - Absolute deviation can be specified with 'BMR_TYPE="abs"'. This defines the BMD as an absolute change from the control dose of zero by a specified amount. That is the BMD is the dose that solves the equation \eqn{\mid f(dose) - f(0) \mid = BMR} -#' @param BRM This option specifies the benchmark response BMR. The BMR is defined in relation to the BMD calculation requested (see BMD). By default, the "BMR = 0.1." -#' @param point_p This option is only used for hybrid BMD calculations. It defines a probability that is the cutpoint for observations. It is the probability that observations have this probability, or less, of being observed at the background dose. -#' @param alpha Alpha is the specified nominal coverage rate for computation of the lower bound on the BMDL and BMDU, i.e., one computes a \eqn{100\times(1-\alpha)% confidence interval}. For the interval (BMDL,BMDU) this is a \eqn{100\times(1-2\alpha)% confidence interval}. By default, it is set to 0.05. +#' - Absolute deviation can be specified with 'BMR_TYPE="abs"'. This defines the BMD as an absolute change from the control dose of zero by a specified amount. That is the BMD is the dose that solves the equation \eqn{\mid f(dose) - f(0) \mid = BMR}. +#' @param BMR This option specifies the benchmark response BMR. The BMR is defined in relation to the BMD calculation requested (see BMD). By default, the "BMR = 0.1."\cr +#' @param point_p This option is only used for hybrid BMD calculations. It defines a probability that is the cutpoint for observations. It is the probability that observations have this probability, or less, of being observed at the background dose. \cr +#' @param alpha Alpha is the specified nominal coverage rate for computation of the lower bound on the BMDL and BMDU, i.e., one computes a \eqn{100\times(1-\alpha)\%} confidence interval. For the interval (BMDL,BMDU) this is a \eqn{100\times(1-2\alpha)\%} confidence interval. By default, it is set to 0.05. #' @param samples the number of samples to take (MCMC only) #' @param degree the number of degrees of a polynomial model. Only used for polynomial models. #' @param burnin the number of burnin samples to take (MCMC only) +#' @param distribution The underlying distribution used as the data distribution. #' @param ewald perform Wald CI computation instead of the default profile likelihood computation. This is the the 'FAST BMD' method of Ewald et al (2021) #' @param transform Transforms doses using \eqn{\log(dose+\sqrt{dose^2+1})}. Note: this is a log transform that has a derivative defined when dose =0. #' @return a model object @@ -47,7 +50,7 @@ #' M2[,2] <- c(6,5.2,2.4,1.1,0.75) #' M2[,3] <- c(20,20,19,20,20) #' M2[,4] <- c(1.2,1.1,0.81,0.74,0.66) -#' model = single_continuous_fit(M2[,1,drop=F], M2[,2:4], BMD_TYPE="sd", BMR=1, ewald = T, +#' model = single_continuous_fit(M2[,1,drop=FALSE], M2[,2:4], BMD_TYPE="sd", BMR=1, ewald = TRUE, #' distribution = "normal",fit_type="laplace",model_type = "hill") #' #' @export @@ -59,7 +62,23 @@ single_continuous_fit <- function(D,Y,model_type="hill", fit_type = "laplace", transform = FALSE){ Y <- as.matrix(Y) D <- as.matrix(D) - + + dis_type = which(distribution == c("normal","normal-ncv","lognormal")) + + if (dis_type == 3){ + is_neg = .check_negative_response(Y) + if (is_neg){ + stop("Can't fit a negative response to the log-normal distribution.") + } + } + + DATA <- cbind(D,Y); + test <- .check_for_na(DATA) + Y = Y[test==TRUE,,drop=F] + D = D[test==TRUE,,drop=F] + DATA <- cbind(D,Y); + + myD = Y; sstat = F # set sufficient statistics to false if there is only one column if (ncol(Y) > 1){ @@ -71,7 +90,7 @@ single_continuous_fit <- function(D,Y,model_type="hill", fit_type = "laplace", if (class(prior) != "BMD_Bayes_continuous_model"){ stop("Prior is not the correct form. Please use a Bayesian Continuous Prior Model.") } - t_prior_result <- parse_prior(prior) + t_prior_result <- .parse_prior(prior) distribution <- t_prior_result$distribution model_type <- t_prior_result$model prior = t_prior_result$prior @@ -84,7 +103,7 @@ single_continuous_fit <- function(D,Y,model_type="hill", fit_type = "laplace", "hill","exp-3","exp-5","power","FUNL","polynomial"') } - PR = bayesian_prior_continuous_default(model_type,distribution,degree) + PR = .bayesian_prior_continuous_default(model_type,distribution,degree) #specify variance of last parameter to variance of response if(distribution == "lognormal"){ if (ncol(Y)>1){ @@ -122,16 +141,14 @@ single_continuous_fit <- function(D,Y,model_type="hill", fit_type = "laplace", if (rt == 4){ rt = 6; } - dis_type = which(distribution == c("normal","normal-ncv","lognormal")) - if(identical(dis_type,integer(0))){ stop('Please specify the distribution as one of the following:\n "normal","normal-ncv","lognormal"') } - - DATA <- cbind(D,Y); + + if (ncol(DATA)==4){ colnames(DATA) = c("Dose","Resp","N","StDev") }else if (ncol(DATA) == 2){ @@ -175,7 +192,7 @@ single_continuous_fit <- function(D,Y,model_type="hill", fit_type = "laplace", #For MLE if (type_of_fit == 2){ - PR = MLE_bounds_continuous(model_type,distribution,degree, is_increasing) + PR = .MLE_bounds_continuous(model_type,distribution,degree, is_increasing) PR = PR$priors } @@ -219,7 +236,7 @@ single_continuous_fit <- function(D,Y,model_type="hill", fit_type = "laplace", # // return(PR) if (fit_type == "mcmc"){ - rvals <- run_continuous_single_mcmc(fitmodel,model_data$SSTAT,model_data$X, + rvals <- .run_continuous_single_mcmc(fitmodel,model_data$SSTAT,model_data$X, PR ,options, is_log_normal, sstat) if (model_type == "exp-3"){ @@ -264,7 +281,7 @@ single_continuous_fit <- function(D,Y,model_type="hill", fit_type = "laplace", }else{ options[7] <- (ewald == TRUE)*1 - rvals <- run_continuous_single(fitmodel,model_data$SSTAT,model_data$X, + rvals <- .run_continuous_single(fitmodel,model_data$SSTAT,model_data$X, PR,options, dist_type) rvals$bmd_dist = rvals$bmd_dist[!is.infinite(rvals$bmd_dist[,1]),,drop=F] @@ -296,45 +313,47 @@ single_continuous_fit <- function(D,Y,model_type="hill", fit_type = "laplace", return (rvals) } } +# +# print.BMDcont_fit_MCMC<-function(x,...){ +# p = x +# BMDtype <- c('Absolute Deviation','Standard Deviation','Relative Deviation','Hybrid') +# +# +# cat ("Benchmark Dose Estimates using MCMC. \n") +# cat (sprintf("Continuous %s BMD: BMRF-%1.2f\n",BMDtype[p$options[1]],p$options[2])) +# cat (sprintf("Model Type: %s\n",p$model)) +# cat ("BMD (BMDL,BMDU) \n") +# cat ("---------------------\n") +# m <- mean(p$BMD) +# x <- quantile(p$BMD,c(p$options[4],1-p$options[4])) +# cat (sprintf("%1.2f (%1.2f,%1.2f)\n%1.2f%s\n",m,x[1],x[2],100*(1-2*p$options[4]),"% 2-sided Confidence Interval")) +# } +# +# print.BMDcont_fit_laplace<-function(x,...){ +# p = x +# BMDtype <- c('Absolute Deviation','Standard Deviation','Relative Deviation','Hybrid') +# +# cat ("Benchmark Dose Estimates using Laplace \n") +# cat ("approximation to the Posterior\n") +# cat (sprintf("Continuous %s BMD: BMRF-%1.2f\n",BMDtype[p$options[1]],p$options[2])) +# cat (sprintf("Model Type: %s\n",p$model)) +# cat ("BMD (BMDL,BMDU) \n") +# cat ("---------------------\n") +# cat (sprintf("%1.2f (%1.2f,%1.2f)\n%1.2f%s\n",p$bmd[1],p$bmd[2],p$bmd[3],100*(1-2*p$options[4]),"% 2-sided Confidence Interval")) +# } -print.BMDcont_fit_MCMC<-function(p){ - - BMDtype <- c('Absolute Deviation','Standard Deviation','Relative Deviation','Hybrid') - - - cat ("Benchmark Dose Estimates using MCMC. \n") - cat (sprintf("Continuous %s BMD: BMRF-%1.2f\n",BMDtype[p$options[1]],p$options[2])) - cat (sprintf("Model Type: %s\n",p$model)) - cat ("BMD (BMDL,BMDU) \n") - cat ("---------------------\n") - m <- mean(p$BMD) - x <- quantile(p$BMD,c(p$options[4],1-p$options[4])) - cat (sprintf("%1.2f (%1.2f,%1.2f)\n%1.2f%s\n",m,x[1],x[2],100*(1-2*p$options[4]),"% 2-sided Confidence Interval")) -} - -print.BMDcont_fit_laplace<-function(p){ - BMDtype <- c('Absolute Deviation','Standard Deviation','Relative Deviation','Hybrid') - - cat ("Benchmark Dose Estimates using Laplace \n") - cat ("approximation to the Posterior\n") - cat (sprintf("Continuous %s BMD: BMRF-%1.2f\n",BMDtype[p$options[1]],p$options[2])) - cat (sprintf("Model Type: %s\n",p$model)) - cat ("BMD (BMDL,BMDU) \n") - cat ("---------------------\n") - cat (sprintf("%1.2f (%1.2f,%1.2f)\n%1.2f%s\n",p$bmd[1],p$bmd[2],p$bmd[3],100*(1-2*p$options[4]),"% 2-sided Confidence Interval")) -} - -print.BMDcont_fit_mle<-function(p){ - BMDtype <- c('Absolute Deviation','Standard Deviation','Relative Deviation','Hybrid') - - cat ("Benchmark Dose Estimates using MLE \n") - cat (sprintf("Continuous %s BMD: BMRF-%1.2f\n",BMDtype[p$options[1]],p$options[2])) - - cat (sprintf("Model Type: %s\n",p$model)) - cat ("BMD (BMDL,BMDU) \n") - cat ("---------------------\n") - cat (sprintf("%1.2f (%1.2f,%1.2f)\n%1.2f%s\n",p$bmd[1],p$bmd[2],p$bmd[3],100*(1-2*p$options[4]),"% 2-sided Confidence Interval")) -} +# print.BMDcont_fit_mle<-function(x,...){ +# p = x +# BMDtype <- c('Absolute Deviation','Standard Deviation','Relative Deviation','Hybrid') +# +# cat ("Benchmark Dose Estimates using MLE \n") +# cat (sprintf("Continuous %s BMD: BMRF-%1.2f\n",BMDtype[p$options[1]],p$options[2])) +# +# cat (sprintf("Model Type: %s\n",p$model)) +# cat ("BMD (BMDL,BMDU) \n") +# cat ("---------------------\n") +# cat (sprintf("%1.2f (%1.2f,%1.2f)\n%1.2f%s\n",p$bmd[1],p$bmd[2],p$bmd[3],100*(1-2*p$options[4]),"% 2-sided Confidence Interval")) +# } diff --git a/R/data_checks.R b/R/data_checks.R new file mode 100644 index 0000000..6a1a7ca --- /dev/null +++ b/R/data_checks.R @@ -0,0 +1,47 @@ +#Copyright 2021 NIEHS +# +# +#Permission is hereby granted, free of charge, to any person obtaining a copy of this software +#and associated documentation files (the "Software"), to deal in the Software without restriction, +#including without limitation the rights to use, copy, modify, merge, publish, distribute, +#sublicense, and/or sell copies of the Software, and to permit persons to whom the Software +#is furnished to do so, subject to the following conditions: +# +#The above copyright notice and this permission notice shall be included in all copies +#or substantial portions of the Software. + +#THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, +#INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A +#PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT +#HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF +#CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE +#OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +.check_for_na <- function(data){ + + + is_a_na <- rep(FALSE,nrow(data)) + for (ii in 1:ncol(data)){ + is_a_na <- is_a_na + is.na(data[,ii]) + is.infinite(data[,ii]) + is.nan(data[,ii]) + } + + if ( sum(is_a_na) > 0){ + warning("Infinite or NA value was found. These data row(s) + were removed from the analysis.") + } + + data <- data[!(is_a_na > 0),,drop=F] + + if (nrow(data) < 3){ + stop("Less than three viable data rows were found.") + } + return(!(is_a_na > 0)) +} + + .check_negative_response <- function(Y){ + + if (sum(Y[,1] <=0) >=1 ){ + return(TRUE) + }else{ + return(FALSE) + } + } \ No newline at end of file diff --git a/R/dichotomous_plots.R b/R/dichotomous_plots.R index dac4f0d..79ff4e6 100644 --- a/R/dichotomous_plots.R +++ b/R/dichotomous_plots.R @@ -80,8 +80,15 @@ } { - .plot.BMDdich_fit_MCMC <-function(fit,fit_type="MCMC",qprob=0.05,...){ - + .plot.BMDdich_fit_MCMC <-function(x,...){ + fit = x + temp_args = list(...) + + if (!exists("qprob",temp_args)){ + qprob = 0.05 + }else{ + qprob = temp_args$qprob + } density_col="red" credint_col="azure2" BMD_DENSITY = T @@ -168,7 +175,7 @@ plot_gg <-ggplot()+ geom_errorbar(aes(x=doses, ymin=lerror, ymax=uerror),color="grey")+ - labs(x="Dose", y="Proportion",title=paste(fit$full_model, fit_type,sep=", Fit Type: " ))+ + labs(x="Dose", y="Proportion",title=paste(fit$full_model,sep=", Fit Type: " ))+ theme_minimal()+ xlim(0-5*max(test_doses),5*max(test_doses)) @@ -226,8 +233,16 @@ } -.plot.BMDdich_fit_maximized <- function(fit,fit_type="Maximized",...){ - +.plot.BMDdich_fit_maximized <- function(x, ...){ + fit = x + temp_args = list(...) + if (!exists("qprob",temp_args)){ + qprob = 0.05 + }else{ + qprob = temp_args$qprob + } + + density_col="red" credint_col="azure2" @@ -284,7 +299,7 @@ plot_gg<-ggplot()+ geom_errorbar(aes(x=doses, ymin=lerror, ymax=uerror),color="grey")+ xlim(c(min(dose)-5*max(dose),max(dose)*5)) + - labs(x="Dose", y="Proportion",title=paste(fit$full_model, fit_type,sep=", Fit Type: " ))+theme_minimal() + labs(x="Dose", y="Proportion",title=paste(fit$full_model,sep=", Fit Type: " ))+theme_minimal() @@ -309,7 +324,17 @@ } -.plot.BMDdichotomous_MA <- function(A,qprob=0.05,...){ +.plot.BMDdichotomous_MA <- function(x,...){ + A = x + model_no <- x_axis <- y_axis <-cols <- NULL + temp_args = list(...) + + if (!exists("qprob",temp_args)){ + qprob = 0.05 + }else{ + qprob = temp_args$qprob + } + density_col="blueviolet" credint_col="azure2" fit_origin<-A #Updated SL @@ -498,10 +523,10 @@ return(plot_gg + coord_cartesian(xlim=c(min(doses),max(doses)),expand=F)) - }else if ("BMDdichotomous_MA_maximized" %in% class(A)){ # mcmc run + }else if ("BMDdichotomous_MA_laplace" %in% class(A)){ # mcmc run class_list <- names(A) - fit_idx <- grep("Fitted_Model_",class_list) + fit_idx <- grep("Individual_Model",class_list) num_model<-length(A$posterior_probs) data_d <- A[[1]]$data @@ -635,11 +660,9 @@ } - + return(plot_gg+ coord_cartesian(xlim=c(min(doses),max(doses)),expand=F)) - - - + } } diff --git a/R/dichotomous_wrappers.R b/R/dichotomous_wrappers.R index 530a3b7..860c9ed 100644 --- a/R/dichotomous_wrappers.R +++ b/R/dichotomous_wrappers.R @@ -4,10 +4,12 @@ #' @param D A numeric vector or matrix of doses. #' @param Y A numeric vector or matrix of responses. #' @param N A numeric vector or matrix of the number of replicates at a dose. +#' @param model_type The mean model for the dichotomous model fit. It can be one of the following: \cr +#' "hill","gamma","logistic", "log-logistic", "log-probit" ,"multistage" ,"probit","qlinear","weibull" #' @param fit_type the method used to fit (laplace, mle, or mcmc) -#' @param prior -#' @param BRM This option specifies the benchmark response BMR. The BMR is defined in relation to the BMD calculation requested (see BMD). By default, the "BMR = 0.1." -#' @param alpha Alpha is the specified nominal coverage rate for computation of the lower bound on the BMDL and BMDU, i.e., one computes a \eqn{100\times(1-\alpha)% confidence interval}. For the interval (BMDL,BMDU) this is a \eqn{100\times(1-2\alpha)% confidence interval}. By default, it is set to 0.05. +#' @param prior Used if you want to specify a prior for the data. +#' @param BMR This option specifies the benchmark response BMR. The BMR is defined in relation to the BMD calculation requested (see BMD). By default, the "BMR = 0.1." +#' @param alpha Alpha is the specified nominal coverage rate for computation of the lower bound on the BMDL and BMDU, i.e., one computes a \eqn{100\times(1-\alpha)\%} . For the interval (BMDL,BMDU) this is a \eqn{100\times(1-2\alpha)\% } confidence interval. By default, it is set to 0.05. #' @param degree the number of degrees of a polynomial model. Only used for polynomial models. #' @param samples the number of samples to take (MCMC only) #' @param burnin the number of burnin samples to take (MCMC only) @@ -18,22 +20,28 @@ #' 3, 10, 50, #' 16, 18,50, #' 32, 18,50, -#' 33, 17,50),nrow=6,ncol=3,byrow=T) +#' 33, 17,50),nrow=6,ncol=3,byrow=TRUE) #' D <- mData[,1] #' Y <- mData[,2] #' N <- mData[,3] #' model = single_dichotomous_fit(D, Y, N, model_type = "hill", fit_type = "laplace") #' single_dichotomous_fit <- function(D,Y,N,model_type, fit_type = "laplace", - prior="default", BMR = 0.1, + prior=NULL, BMR = 0.1, alpha = 0.05, degree=2,samples = 21000, burnin = 1000){ Y <- as.matrix(Y) D <- as.matrix(D) N <- as.matrix(N) - if (class(prior) == "character"){ - prior = bayesian_prior_dich(model_type,degree); + DATA <- cbind(D,Y,N); + test <- .check_for_na(DATA) + Y = Y[test==TRUE,,drop=F] + D = D[test==TRUE,,drop=F] + N = N[test==TRUE,,drop=F] + + if (is.null(prior)){ + prior = .bayesian_prior_dich(model_type,degree); }else{ if (class(prior) !="BMD_Bayes_dichotomous_model"){ @@ -77,8 +85,8 @@ single_dichotomous_fit <- function(D,Y,N,model_type, fit_type = "laplace", if (fitter == 1){ #MLE fit - bounds = bmd_default_frequentist_settings(model_type,degree) - temp = run_single_dichotomous(dmodel,DATA,bounds,o1,o2); + bounds = .bmd_default_frequentist_settings(model_type,degree) + temp = .run_single_dichotomous(dmodel,DATA,bounds,o1,o2); #class(temp$bmd_dist) <- "BMD_CDF" temp_me = temp$bmd_dist @@ -99,7 +107,7 @@ single_dichotomous_fit <- function(D,Y,N,model_type, fit_type = "laplace", if (fitter == 2){ #laplace fit - temp = run_single_dichotomous(dmodel,DATA,prior$priors,o1,o2); + temp = .run_single_dichotomous(dmodel,DATA,prior$priors,o1,o2); #class(temp$bmd_dist) <- "BMD_CDF" te <- splinefun(temp$bmd_dist[!is.infinite(temp$bmd_dist[,1]),2],temp$bmd_dist[!is.infinite(temp$bmd_dist[,1]),1],method="hyman") temp$bmd <- c(temp$bmd,te(alpha),te(1-alpha)) @@ -110,9 +118,11 @@ single_dichotomous_fit <- function(D,Y,N,model_type, fit_type = "laplace", } if (fitter ==3){ - temp = run_dichotomous_single_mcmc(dmodel,DATA[,2:3,drop=F],DATA[,1,drop=F],prior$priors, + temp = .run_dichotomous_single_mcmc(dmodel,DATA[,2:3,drop=F],DATA[,1,drop=F],prior$priors, c(BMR, alpha,samples,burnin)) #class(temp$fitted_model$bmd_dist) <- "BMD_CDF" + temp$bmd_dist <- cbind(quantile(temp$mcmc_result$BMD_samples,seq(0.005,0.995,0.005)),seq(0.005,0.995,0.005)) + temp$options = options = c(BMR, alpha,samples,burnin) ; temp$prior = prior = list(prior = prior); temp$model = model_type; @@ -129,7 +139,8 @@ single_dichotomous_fit <- function(D,Y,N,model_type, fit_type = "laplace", return(temp) } -.print.BMD_CDF<-function(p){ +.print.BMD_CDF<-function(x, ...){ + p = x x <- splinefun(p[!is.infinite(p[,1]),2],p[!is.infinite(p[,1]),1],method="hyman") cat("Approximate Quantiles for the BMD\n") cat("--------------------------------------------------------------\n") @@ -140,30 +151,32 @@ single_dichotomous_fit <- function(D,Y,N,model_type, fit_type = "laplace", x(0.01),x(0.05),x(0.10),x(0.25),x(.5),x(0.75),x(0.90),x(0.95),x(0.99))) } -print.BMDdich_fit_MCMC<-function(p){ - cat ("Benchmark Dose Estimates using MCMC. \n") - cat (sprintf("Extra Risk: BMR:%1.2f\n",p$options[1])) - cat (sprintf("Model Type: %s\n",p$model[1])) - cat ("BMD (BMDL,BMDU) \n") - cat ("---------------------\n") - m <- mean(p$BMD) - x <- quantile(p$BMD,c(p$options[2],1-p$options[2])) - cat (sprintf("%1.2f (%1.2f,%1.2f)\n%1.2f%s\n",m,x[1],x[2],100*(1-2*p$options[2]),"% 2-sided Confidence Interval")) -} +# print.BMDdich_fit_MCMC<-function(x, ...){ +# p = x +# cat ("Benchmark Dose Estimates using MCMC. \n") +# cat (sprintf("Extra Risk: BMR:%1.2f\n",p$options[1])) +# cat (sprintf("Model Type: %s\n",p$model[1])) +# cat ("BMD (BMDL,BMDU) \n") +# cat ("---------------------\n") +# m <- mean(p$BMD) +# x <- quantile(p$BMD,c(p$options[2],1-p$options[2])) +# cat (sprintf("%1.2f (%1.2f,%1.2f)\n%1.2f%s\n",m,x[1],x[2],100*(1-2*p$options[2]),"% 2-sided Confidence Interval")) +# } -.print.BMDdich_fit<-function(p){ - cat ("Benchmark Dose Estimates\n") - cat ("Approximation to the Posterior\n") - cat (sprintf("Model Type: %s\n",p$full_model)) - cat ("BMD (BMDL,BMDU) \n") - cat ("---------------------\n") - temp = p$bmd_dist - temp = temp[!is.infinite(temp[,1]),] - spfun = splinefun(temp[,2],temp[,1],method = "hyman") - cat (sprintf("%1.2f (%1.2f,%1.2f)\n%1.2f%s\n",spfun(0.5),spfun(0.05),spfun(0.95),90,"% 2-sided Confidence Interval")) -} +# .print.BMDdich_fit<-function(x, ...){ +# p = x +# cat ("Benchmark Dose Estimates\n") +# cat ("Approximation to the Posterior\n") +# cat (sprintf("Model Type: %s\n",p$full_model)) +# cat ("BMD (BMDL,BMDU) \n") +# cat ("---------------------\n") +# temp = p$bmd_dist +# temp = temp[!is.infinite(temp[,1]),] +# spfun = splinefun(temp[,2],temp[,1],method = "hyman") +# cat (sprintf("%1.2f (%1.2f,%1.2f)\n%1.2f%s\n",spfun(0.5),spfun(0.05),spfun(0.95),90,"% 2-sided Confidence Interval")) +# } -bmd_default_frequentist_settings <- function(model,degree=2){ +.bmd_default_frequentist_settings <- function(model,degree=2){ dmodel = which(model==c("hill","gamma","logistic", "log-logistic", "log-probit" ,"multistage" ,"probit", "qlinear","weibull")) @@ -217,57 +230,57 @@ bmd_default_frequentist_settings <- function(model,degree=2){ return(prior) } # fix me - remove - -bmd_default_bayesian_prior <- function(model,degree=2){ - dmodel = which(model==c("hill","gamma","logistic", "log-logistic", - "log-probit" ,"multistage" ,"probit", - "qlinear","weibull")) - if (dmodel==1){ #HILL - prior <- matrix(c(1, -1, 2, -40, 40, - 1, 0, 3, -40, 40, - 1, -3, 3.3, -40, 40, - 2, 0.693147, 0.5, 0, 40),nrow=4,ncol=5,byrow=T) - } - if (dmodel==2){ #GAMMA - prior <- matrix(c(1, 0, 2, -18, 18, - 2, 0.693147180559945, 0.424264068711929, 0.2, 20, - 2, 0, 1, 0, 1e4),nrow=3,ncol=5,byrow=T) - } - if (dmodel == 3){ #LOGISTIC - prior <- matrix(c(1, 0, 2, -20, 20, - 2, 0.1, 1, 0, 40 ),nrow=2,ncol=5,byrow=T) - } - if (dmodel == 4){ #LOG-LOGISTIC - prior <- matrix(c(1, 0, 2, -20, 20, - 1, 0, 1, -40, 40, - 2, 0.693147180559945, 0.5, 1.00E-04, 20),nrow=3,ncol=5,byrow=T) - } - if (dmodel == 5){ #LOG-PROBIT - prior <- matrix(c(1, 0, 2, -20, 20, - 1, 0, 1, -40, 40, - 2, 0.693147180559945, 0.5, 1.00E-04, 40),nrow=3,ncol=5,byrow=T) - } - - if (dmodel == 6){ #MULTISTAGE - temp <- matrix(c(1, 0, 2, -20, 20, - 2, 0, 0.5, 1.00E-04, 100, - 2, 0, 1, 1.00E-04, 1.00E+06),nrow=3,ncol=5,byrow=T) - prior <- matrix(c(2, 0, 1, 1.00E-04, 1.00E+06),nrow=1+degree,ncol=5,byrow=T) - prior[1:3,] <- temp; - } - if (dmodel == 7){ #PROBIT - prior <- matrix(c(1, -2, 2, -8, 8, - 2, 0.1, 1, 1.00E-12, 40 ),nrow=2,ncol=5,byrow=T) - } - if (dmodel == 8){ #QLINEAR - prior <- matrix(c(1, 0, 2,-18, 18, - 2, 0.15, 1, 0, 18),nrow=2,ncol=5,byrow=T) - } - if (dmodel == 9){ #WEIBULL - prior <- matrix(c(1, 0, 2, -20, 20, - 2, 0.424264068711929, 0.5, 0, 40, - 2, 0, 1.5, 0, 1e4),nrow=3,ncol=5,byrow=T) - } - - return(prior) -} \ No newline at end of file +# +# bmd_default_bayesian_prior <- function(model,degree=2){ +# dmodel = which(model==c("hill","gamma","logistic", "log-logistic", +# "log-probit" ,"multistage" ,"probit", +# "qlinear","weibull")) +# if (dmodel==1){ #HILL +# prior <- matrix(c(1, -1, 2, -40, 40, +# 1, 0, 3, -40, 40, +# 1, -3, 3.3, -40, 40, +# 2, 0.693147, 0.5, 0, 40),nrow=4,ncol=5,byrow=T) +# } +# if (dmodel==2){ #GAMMA +# prior <- matrix(c(1, 0, 2, -18, 18, +# 2, 0.693147180559945, 0.424264068711929, 0.2, 20, +# 2, 0, 1, 0, 1e4),nrow=3,ncol=5,byrow=T) +# } +# if (dmodel == 3){ #LOGISTIC +# prior <- matrix(c(1, 0, 2, -20, 20, +# 2, 0.1, 1, 0, 40 ),nrow=2,ncol=5,byrow=T) +# } +# if (dmodel == 4){ #LOG-LOGISTIC +# prior <- matrix(c(1, 0, 2, -20, 20, +# 1, 0, 1, -40, 40, +# 2, 0.693147180559945, 0.5, 1.00E-04, 20),nrow=3,ncol=5,byrow=T) +# } +# if (dmodel == 5){ #LOG-PROBIT +# prior <- matrix(c(1, 0, 2, -20, 20, +# 1, 0, 1, -40, 40, +# 2, 0.693147180559945, 0.5, 1.00E-04, 40),nrow=3,ncol=5,byrow=T) +# } +# +# if (dmodel == 6){ #MULTISTAGE +# temp <- matrix(c(1, 0, 2, -20, 20, +# 2, 0, 0.5, 1.00E-04, 100, +# 2, 0, 1, 1.00E-04, 1.00E+06),nrow=3,ncol=5,byrow=T) +# prior <- matrix(c(2, 0, 1, 1.00E-04, 1.00E+06),nrow=1+degree,ncol=5,byrow=T) +# prior[1:3,] <- temp; +# } +# if (dmodel == 7){ #PROBIT +# prior <- matrix(c(1, -2, 2, -8, 8, +# 2, 0.1, 1, 1.00E-12, 40 ),nrow=2,ncol=5,byrow=T) +# } +# if (dmodel == 8){ #QLINEAR +# prior <- matrix(c(1, 0, 2,-18, 18, +# 2, 0.15, 1, 0, 18),nrow=2,ncol=5,byrow=T) +# } +# if (dmodel == 9){ #WEIBULL +# prior <- matrix(c(1, 0, 2, -20, 20, +# 2, 0.424264068711929, 0.5, 0, 40, +# 2, 0, 1.5, 0, 1e4),nrow=3,ncol=5,byrow=T) +# } +# +# return(prior) +# } diff --git a/R/model_averaging_fits.R b/R/model_averaging_fits.R index 6592875..5d49863 100644 --- a/R/model_averaging_fits.R +++ b/R/model_averaging_fits.R @@ -10,14 +10,15 @@ #' - Relative deviation can be specified with 'BMR_TYPE = "rel"'. This defines the BMD as the dose that changes the control mean/median a certain percentage from the background dose, i.e. it is the dose, BMD that solves \eqn{\mid f(dose) - f(0) \mid = (1 \pm BMR) f(0)} \cr #' - Hybrid deviation can be specified with 'BMR_TYPE = "hybrid"'. This defines the BMD that changes the probability of an adverse event by a stated amount relitive to no exposure (i.e 0). That is, it is the dose, BMD, that solves \eqn{\frac{Pr(X > x| dose) - Pr(X >x|0)}{Pr(X < x|0)} = BMR}. For this definition, \eqn{Pr(X < x|0) = 1 - Pr(X > X|0) = \pi_0}, where \eqn{0 \leq \pi_0 < 1} is defined by the user as "point_p," and it defaults to 0.01. Note: this discussion assumed increasing data. The fitter determines the direction of the data and inverts the probability statements for decreasing data. \cr #' - Absolute deviation can be specified with 'BMR_TYPE="abs"'. This defines the BMD as an absolute change from the control dose of zero by a specified amount. That is the BMD is the dose that solves the equation \eqn{\mid f(dose) - f(0) \mid = BMR} -#' @param BRM This option specifies the benchmark response BMR. The BMR is defined in relation to the BMD calculation requested (see BMD). By default, the "BMR = 0.1." +#' @param BMR This option specifies the benchmark response BMR. The BMR is defined in relation to the BMD calculation requested (see BMD). By default, the "BMR = 0.1." #' @param point_p This option is only used for hybrid BMD calculations. It defines a probability that is the cutpoint for observations. It is the probability that observations have this probability, or less, of being observed at the background dose. -#' @param alpha Alpha is the specified nominal coverage rate for computation of the lower bound on the BMDL and BMDU, i.e., one computes a \eqn{100\times(1-\alpha)% confidence interval}. For the interval (BMDL,BMDU) this is a \eqn{100\times(1-2\alpha)% confidence interval}. By default, it is set to 0.05. +#' @param alpha Alpha is the specified nominal coverage rate for computation of the lower bound on the BMDL and BMDU, i.e., one computes a \eqn{100\times(1-\alpha)\%} confidence interval. For the interval (BMDL,BMDU) this is a \eqn{100\times(1-2\alpha)\% }. By default, it is set to 0.05. #' @param samples the number of samples to take (MCMC only) #' @param burnin the number of burnin samples to take (MCMC only) #' @return a model object containing a list of single models #' #' @examples +#'\dontrun{ #' Hill.p <- rbind(c(481,-250.3,70,3.3), #' c(481,-250.3,40,1.3), #' c(481,-250.2,15,1.1), @@ -28,11 +29,10 @@ #' c(10.58,9.7,50,4)) #' hill <- data.frame(a=Hill.p[,1],b=Hill.p[,2],c=Hill.p[,3],d=Hill.p[,4]) #' doses <- rep(c(0,6.25,12.5,25,50,100),each=10) -#' dosesq <- rep(c(0,6.25,12.5,25,50,100),each=30) -#' mean <- cont_hill_f(as.numeric(hill[2,]),doses) -#' y <- rinvgauss(length(mean),mean,18528.14) +#' mean <- ToxicR:::.cont_hill_f(as.numeric(hill[2,]),doses) +#' y <- rnorm(length(mean),mean,20.14) #' model <- ma_continuous_fit(doses, y, fit_type = "laplace", BMD_TYPE = 'sd', BMR = 1) -#' +#' } #' @export ma_continuous_fit <- function(D,Y,model_list=NA, fit_type = "laplace", BMD_TYPE = "sd", BMR = 0.1, point_p = 0.01, @@ -42,6 +42,14 @@ ma_continuous_fit <- function(D,Y,model_list=NA, fit_type = "laplace", Y = as.matrix(Y) D = as.matrix(D) + is_neg = .check_negative_response(Y) + + DATA <- cbind(D,Y); + test <- .check_for_na(DATA) + Y = Y[test==TRUE,,drop=F] + D = D[test==TRUE,,drop=F] + DATA <- cbind(D,Y); + current_models = c("hill","exp-3","exp-5","power","FUNL") current_dists = c("normal","normal-ncv","lognormal") type_of_fit = which(fit_type == c('laplace','mcmc')) @@ -63,10 +71,21 @@ ma_continuous_fit <- function(D,Y,model_list=NA, fit_type = "laplace", model_list = c(rep("hill",2),rep("exp-3",3),rep("exp-5",3),rep("power",2)) distribution_list = c("normal","normal-ncv",rep(c("normal","normal-ncv","lognormal"),2), "normal","normal-ncv") - + if (is_neg){ + tmpIdx = which(distribution_list == "lognormal") + model_list = model_list[-tmpIdx] + distribution_list = distribution_list[-tmpIdx] + if (length(distribution_list) > 1) # need at least 2 models for model averaging + { + warning("Negative response values were found in the data. All lognormal + models were removed from the analysis.") + }else{ + stop("Negative response values were found in the data. All lognormal models were removed from the analysis, but there were not enough models available for the MA.") + } + } prior_list <- list() for(ii in 1:length(model_list)){ - PR = bayesian_prior_continuous_default(model_list[ii],distribution_list[ii],2) + PR = .bayesian_prior_continuous_default(model_list[ii],distribution_list[ii],2) #specify variance of last parameter to variance of response if(distribution_list[ii] == "lognormal"){ if (ncol(Y)>1){ @@ -103,7 +122,7 @@ ma_continuous_fit <- function(D,Y,model_list=NA, fit_type = "laplace", if (class(temp_prior) != "BMD_Bayes_continuous_model"){ stop("Prior is not the correct form. Please use a Bayesian Continuous Prior Model.") } - result <- parse_prior(temp_prior) + result <- .parse_prior(temp_prior) distribution <- result$distribution model_type <- result$model @@ -165,7 +184,7 @@ ma_continuous_fit <- function(D,Y,model_list=NA, fit_type = "laplace", if (fit_type == "mcmc"){ - temp_r <- run_continuous_ma_mcmc(priors, models, dlists,Y,D, + temp_r <- .run_continuous_ma_mcmc(priors, models, dlists,Y,D, options) tempn <- temp_r$ma_results @@ -247,7 +266,7 @@ ma_continuous_fit <- function(D,Y,model_list=NA, fit_type = "laplace", return(temp) }else{ - temp <- run_continuous_ma_laplace(priors, models, dlists,Y,D, + temp <- .run_continuous_ma_laplace(priors, models, dlists,Y,D, options) t_names <- names(temp) @@ -332,26 +351,26 @@ ma_continuous_fit <- function(D,Y,model_list=NA, fit_type = "laplace", #' - Relative deviation can be specified with 'BMR_TYPE = "rel"'. This defines the BMD as the dose that changes the control mean/median a certain percentage from the background dose, i.e. it is the dose, BMD that solves \eqn{\mid f(dose) - f(0) \mid = (1 \pm BMR) f(0)} \cr #' - Hybrid deviation can be specified with 'BMR_TYPE = "hybrid"'. This defines the BMD that changes the probability of an adverse event by a stated amount relitive to no exposure (i.e 0). That is, it is the dose, BMD, that solves \eqn{\frac{Pr(X > x| dose) - Pr(X >x|0)}{Pr(X < x|0)} = BMR}. For this definition, \eqn{Pr(X < x|0) = 1 - Pr(X > X|0) = \pi_0}, where \eqn{0 \leq \pi_0 < 1} is defined by the user as "point_p," and it defaults to 0.01. Note: this discussion assumed increasing data. The fitter determines the direction of the data and inverts the probability statements for decreasing data. \cr #' - Absolute deviation can be specified with 'BMR_TYPE="abs"'. This defines the BMD as an absolute change from the control dose of zero by a specified amount. That is the BMD is the dose that solves the equation \eqn{\mid f(dose) - f(0) \mid = BMR} -#' @param BRM This option specifies the benchmark response BMR. The BMR is defined in relation to the BMD calculation requested (see BMD). By default, the "BMR = 0.1." +#' @param BMR This option specifies the benchmark response BMR. The BMR is defined in relation to the BMD calculation requested (see BMD). By default, the "BMR = 0.1." #' @param point_p This option is only used for hybrid BMD calculations. It defines a probability that is the cutpoint for observations. It is the probability that observations have this probability, or less, of being observed at the background dose. -#' @param alpha Alpha is the specified nominal coverage rate for computation of the lower bound on the BMDL and BMDU, i.e., one computes a \eqn{100\times(1-\alpha)% confidence interval}. For the interval (BMDL,BMDU) this is a \eqn{100\times(1-2\alpha)% confidence interval}. By default, it is set to 0.05. +#' @param alpha Alpha is the specified nominal coverage rate for computation of the lower bound on the BMDL and BMDU, i.e., one computes a \eqn{100\times(1-\alpha)\% }. For the interval (BMDL,BMDU) this is a \eqn{100\times(1-2\alpha)\% }. By default, it is set to 0.05. #' @param samples the number of samples to take (MCMC only) #' @param burnin the number of burnin samples to take (MCMC only) #' @return a model object containing a list of single models #' #' @examples -#' +#'\dontrun{ #' mData <- matrix(c(0, 2,50, #' 1, 2,50, #' 3, 10, 50, #' 16, 18,50, #' 32, 18,50, -#' 33, 17,50),nrow=6,ncol=3,byrow=T) +#' 33, 17,50),nrow=6,ncol=3,byrow=TRUE) #' D <- mData[,1] #' Y <- mData[,2] #' N <- mData[,3] #' model = ma_dichotomous_fit(D,Y,N) -#' +#' } #' @export ma_dichotomous_fit <- function(D,Y,N,model_list=integer(0), fit_type = "laplace", BMD_TYPE = "extra", @@ -360,21 +379,24 @@ ma_dichotomous_fit <- function(D,Y,N,model_list=integer(0), fit_type = "laplace" D <- as.matrix(D) Y <- as.matrix(Y) N <- as.matrix(N) - + + DATA <- cbind(D,Y,N); + test <- .check_for_na(DATA) + Y = Y[test==TRUE,,drop=F] + D = D[test==TRUE,,drop=F] + N = N[test==TRUE,,drop=F] + priors <- list() temp_prior_l <- list() tmodel_list <- list() if (length(model_list) < 1){ - model_list = .dichotomous_models model_i = rep(0,length(model_list)) for (ii in 1:length(model_list)){ - temp_prior_l[[ii]] = bayesian_prior_dich(model_list[ii]) - + temp_prior_l[[ii]] = .bayesian_prior_dich(model_list[ii]) priors[[ii]] = temp_prior_l[[ii]]$priors model_i[ii] = .dichotomous_model_type(model_list[ii]) } - }else{ if(class(model_list) != "list"){ stop("Please pass a list of priors.") @@ -411,13 +433,13 @@ ma_dichotomous_fit <- function(D,Y,N,model_list=integer(0), fit_type = "laplace" data <- as.matrix(cbind(D,Y,N)) if ( fit_type == "laplace"){ #Laplace Run - temp <- run_ma_dichotomous(data, priors, model_i, + temp <- .run_ma_dichotomous(data, priors, model_i, model_p, FALSE, o1, o2) #clean up the run - temp$bmd_dist <- temp$BMD_CDF + temp$ma_bmd <- temp$BMD_CDF #TO DO : DELETE temp$BMD_CDF - te <- splinefun(temp$bmd_dist[!is.infinite(temp$bmd_dist[,1]),2], - temp$bmd_dist[!is.infinite(temp$bmd_dist[,1]),1],method="hyman") + te <- splinefun(temp$ma_bmd[!is.infinite(temp$ma_bmd[,1]),2], + temp$ma_bmd[!is.infinite(temp$ma_bmd[,1]),1],method="hyman") temp$bmd <- c(te(0.5),te(alpha),te(1-alpha)) t_names <- names(temp) @@ -433,13 +455,15 @@ ma_dichotomous_fit <- function(D,Y,N,model_list=integer(0), fit_type = "laplace" te <- splinefun(temp[[ii]]$bmd_dist[!is.infinite(temp[[ii]]$bmd_dist[,1]),2],temp[[ii]]$bmd_dist[!is.infinite(temp[[ii]]$bmd_dist[,1]),1],method="hyman") temp[[ii]]$bmd <- c(te(0.5),te(alpha),te(1-alpha)) names(temp[[ii]]$bmd) <- c("BMD","BMDL","BMDU") - names(temp[ii])[1] <- sprintf("Individual_Model_%s",ii) + names(temp)[ii] <- sprintf("Individual_Model_%s",ii) + tmp_id = which(names(temp) == "BMD_CDF") + # temp = temp[-tmp_id] } - class(temp) <- c("BMDdichotomous_MA","BMDdichotomous_MA_maximized") + class(temp) <- c("BMDdichotomous_MA","BMDdichotomous_MA_laplace") }else{ #MCMC run - temp_r <- run_ma_dichotomous(data, priors, model_i, + temp_r <- .run_ma_dichotomous(data, priors, model_i, model_p, TRUE, o1, o2) tempn <- temp_r$ma_results tempm <- temp_r$mcmc_runs diff --git a/R/model_averaging_lists.R b/R/model_averaging_lists.R index adb0bbb..3f4e3a1 100644 --- a/R/model_averaging_lists.R +++ b/R/model_averaging_lists.R @@ -2,47 +2,48 @@ # # ########################################## -ma_continuous_list<-function(ml,dl){ - - if (length(ml) != length(dl)){ - stop("Model List Length not the same length as distribution length list.") - } - check_list = ml %in% c("hill","exp-3","exp-5","power","FUNL") - if (sum(check_list) != length(ml)){ - stop('At least one model not specified as "hill","exp-3","exp-5","power",or "FUNL".') - } - check_dist = dl %in% c("normal","normal-ncv","lognormal") - if (sum(check_dist) != length(dl)){ - stop('At least one distribution not in "normal","normal-ncv","lognormal".') - } - - ma_list <- list() - - for (ii in 1:length(ml)){ - a = list(model = ml[ii], dist = dl[ii], - prior = bayesian_prior_continuous_default(ml[ii],dl[ii])) - class(a) <- "BMDcontinuous_bayesian_model" - ma_list[[ii]] <- a - } - - return(ma_list) -} - -print.BMDcontinuous_bayesian_model <-function(data_model){ - model_list = c("hill","exp-3","exp-5","power") - dist_list = c("normal","normal-ncv","lognormal") - MODEL_NAMES = c("Hill Model","Exponential 3 Model", - "Exponential 5 Model","Power Model") - DIST_NAMES = c("Normal", "Normal Non-constant Variance", - "Log-Normal") - - - temp = data_model - m_temp = which(temp$model == model_list) - d_temp = which(temp$dist == dist_list) - cat(sprintf("Prior for the %s\n",MODEL_NAMES[m_temp])); - cat(sprintf("Using %s distribution.\n",DIST_NAMES[d_temp])); - print(data_model$prior) - -} +# ma_continuous_list<-function(ml,dl){ +# +# if (length(ml) != length(dl)){ +# stop("Model List Length not the same length as distribution length list.") +# } +# check_list = ml %in% c("hill","exp-3","exp-5","power","FUNL") +# if (sum(check_list) != length(ml)){ +# stop('At least one model not specified as "hill","exp-3","exp-5","power",or "FUNL".') +# } +# check_dist = dl %in% c("normal","normal-ncv","lognormal") +# if (sum(check_dist) != length(dl)){ +# stop('At least one distribution not in "normal","normal-ncv","lognormal".') +# } +# +# ma_list <- list() +# +# for (ii in 1:length(ml)){ +# a = list(model = ml[ii], dist = dl[ii], +# prior = .bayesian_prior_continuous_default(ml[ii],dl[ii])) +# class(a) <- "BMDcontinuous_bayesian_model" +# ma_list[[ii]] <- a +# } +# +# return(ma_list) +# } +# +# print.BMDcontinuous_bayesian_model <-function(x, ...){ +# data_model = x +# model_list = c("hill","exp-3","exp-5","power") +# dist_list = c("normal","normal-ncv","lognormal") +# MODEL_NAMES = c("Hill Model","Exponential 3 Model", +# "Exponential 5 Model","Power Model") +# DIST_NAMES = c("Normal", "Normal Non-constant Variance", +# "Log-Normal") +# +# +# temp = data_model +# m_temp = which(temp$model == model_list) +# d_temp = which(temp$dist == dist_list) +# cat(sprintf("Prior for the %s\n",MODEL_NAMES[m_temp])); +# cat(sprintf("Using %s distribution.\n",DIST_NAMES[d_temp])); +# print(data_model$prior) +# +# } diff --git a/R/predict.R b/R/predict.R new file mode 100644 index 0000000..823c658 --- /dev/null +++ b/R/predict.R @@ -0,0 +1,248 @@ +#Copyright 2021 NIEHS +# +# +#Permission is hereby granted, free of charge, to any person obtaining a copy of this software +#and associated documentation files (the "Software"), to deal in the Software without restriction, +#including without limitation the rights to use, copy, modify, merge, publish, distribute, +#sublicense, and/or sell copies of the Software, and to permit persons to whom the Software +#is furnished to do so, subject to the following conditions: +# +#The above copyright notice and this permission notice shall be included in all copies +#or substantial portions of the Software. + +#THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, +#INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A +#PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT +#HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF +#CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE +#OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. + +.dichotomous_predict_model <- function(object,...){ + fit <- object + tmp_args = list(...) + if (!exists("new_doses",where=tmp_args)){ + new_doses = NULL + }else{ + new_doses = tmp_args$new_doses + } + if (is.null(new_doses)){ + test_doses = fit$data[,1] + }else{ + test_doses = new_doses + } + + if (fit$model=="hill"){ + f <- .dich_hill_f(fit$parameters,test_doses) + } + if (fit$model=="gamma"){ + f <- .dich_gamma_f(fit$parameters,test_doses) + } + if (fit$model == "logistic"){ + f <- .dich_logist_f(fit$parameters,test_doses) + } + if (fit$model=="log-logistic"){ + f <- .dich_llogist_f(fit$parameters,test_doses) + } + if (fit$model=="probit"){ + f <- .dich_probit_f(fit$parameters,test_doses) + } + if (fit$model=="log-probit"){ + f<- .dich_lprobit_f(fit$parameters,test_doses) + } + if (fit$model=="multistage"){ + f <- .dich_multistage_f(fit$parameters,test_doses) + } + if (fit$model=="qlinear"){ + f<- .dich_qlinear_f(fit$parameters,test_doses) + } + if (fit$model=="weibull"){ + f<- .dich_weibull_f(fit$parameters,test_doses) + } + + returnV <- list(X = test_doses, Y = f) + return(returnV) +} + + +.dichotomous_predict_model_mcmc <- function(object,...){ + fit <- object + tmp_args = list(...) + + if (!exists("new_doses",where=tmp_args)){ + new_doses = NULL + }else{ + new_doses = tmp_args$new_doses + } + + if (is.null(new_doses)){ + test_doses = fit$data[,1] + }else{ + test_doses = new_doses + } + + if (fit$model=="hill"){ + f <- apply(fit$mcmc_result$PARM_samples,1,.dich_hill_f,d=test_doses) + } + if (fit$model=="gamma"){ + f <- apply(fit$mcmc_result$PARM_samples,1,.dich_gamma_f,d=test_doses) + } + if (fit$model == "logistic"){ + f <- apply(fit$mcmc_result$PARM_samples,1,.dich_logist_f,d=test_doses) + } + if (fit$model=="log-logistic"){ + f <- apply(fit$mcmc_result$PARM_samples,1,.dich_llogist_f,d=test_doses) + } + if (fit$model=="probit"){ + f <- apply(fit$mcmc_result$PARM_samples,1,.dich_probit_f,d=test_doses) + } + if (fit$model=="log-probit"){ + f <- apply(fit$mcmc_result$PARM_samples,1,.dich_lprobit_f,d=test_doses) + } + if (fit$model=="multistage"){ + f <- apply(fit$mcmc_result$PARM_samples,1,.dich_multistage_f,d=test_doses) + } + if (fit$model=="qlinear"){ + f <- apply(fit$mcmc_result$PARM_samples,1,.dich_qlinear_f,d=test_doses) + } + if (fit$model=="weibull"){ + f <- apply(fit$mcmc_result$PARM_samples,1,.dich_weibull_f,d=test_doses) + } + + returnV <- list(X = test_doses, Y = f) + return(returnV) +} + +.continuous_predict_model <- function(object,...){ + fit <- object + tmp_args = list(...) + if (!exists("new_doses",where=tmp_args)){ + new_doses = NULL + }else{ + new_doses = tmp_args$new_doses + } + + + data_d = fit$data + + if (ncol(data_d) == 4 ){ #sufficient statistics + mean <- data_d[,2,drop=F] + se <- data_d[,4,drop=F]/sqrt(data_d[,3,drop=F]) + doses <- data_d[,1,drop=F] + lm_fit = lm(mean ~ doses,weights = 1/(se*se)) + }else{ + Response <- data_d[,2,drop=F] + doses = data_d[,1,drop=F] + lm_fit = lm(Response~doses) + } + + if (is.null(new_doses)){ + test_doses = fit$data[,1] + }else{ + test_doses = new_doses + } + + if (coefficients(lm_fit)[2] < 0){ + decrease = TRUE + }else{ + decrease = FALSE + } + + if (fit$model=="FUNL"){ + f <- .cont_FUNL_f(fit$parameters,test_doses) + } + if (fit$model=="hill"){ + f <- .cont_hill_f(fit$parameters,test_doses) + } + if (fit$model=="exp-3"){ + f <- .cont_exp_3_f(fit$parameters,test_doses,decrease) + } + if (fit$model=="exp-5"){ + f <- .cont_exp_5_f(fit$parameters,test_doses) + } + if (fit$model=="power"){ + f <- .cont_power_f(fit$parameters,test_doses) + } + if (fit$model=="polynomial"){ + if (length(grep(": normal-ncv", tolower(fit$full_model)))>0){ + degree = length(fit$parameters) - 2 + }else{ + degree = length(fit$parameters) - 1 + } + + f <- .cont_polynomial_f(fit$parameters[1:degree],test_doses) + } + + if (grepl("Log-Normal",fit$full_model)){ + returnV <- list(X = test_doses, Y = exp(log(as.numeric(f))+ 0.5*exp(fit$parameters[length(fit$parameters)])))#lognormal mean # nolint + }else{ + returnV <- list(X = test_doses, Y = as.numeric(f)) + } + return(returnV) +} + + +.continuous_predict_model_mcmc <- function(object,...){ + fit <- object + tmp_args = list(...) + if (!exists("new_doses",where=tmp_args)){ + new_doses = NULL + }else{ + new_doses = tmp_args$new_doses + } + data_d = fit$data + + if (ncol(data_d) == 4 ){ #sufficient statistics + mean <- data_d[,2,drop=F] + se <- data_d[,4,drop=F]/sqrt(data_d[,3,drop=F]) + doses <- data_d[,1,drop=F] + lm_fit = lm(mean ~ doses,weights = 1/(se*se)) + }else{ + Response <- data_d[,2,drop=F] + doses = data_d[,1,drop=F] + lm_fit = lm(Response~doses) + } + + if (is.null(new_doses)){ + test_doses = fit$data[,1] + }else{ + test_doses = new_doses + } + + if (coefficients(lm_fit)[2] < 0){ + decrease = TRUE + }else{ + decrease = FALSE + } + + if (fit$model=="FUNL"){ + f <- apply(fit$mcmc_result$PARM_samples, 1, .cont_FUNL_f,test_doses) + } + if (fit$model=="hill"){ + f <- apply(fit$mcmc_result$PARM_samples, 1,.cont_hill_f,test_doses) + } + if (fit$model=="exp-3"){ + f <- apply(fit$mcmc_result$PARM_samples, 1,.cont_exp_3_f,test_doses) + } + if (fit$model=="exp-5"){ + f <- apply(fit$mcmc_result$PARM_samples, 1,.cont_exp_5_f,test_doses) + } + if (fit$model=="power"){ + f <- apply(fit$mcmc_result$PARM_samples, 1,.cont_power_f,test_doses) + } + if (fit$model=="polynomial"){ + if (length(grep(": normal-ncv", tolower(fit$full_model)))>0){ + degree = ncol(fit$mcmc_result$PARM_samples) - 2 + }else{ + degree = ncol(fit$mcmc_result$PARM_samples) - 1 + } + + f <- apply(fit$mcmc_result$PARM_samples[,1:degree], 1, .cont_polynomial_f,test_doses) + } + + if (grepl("Log-Normal",fit$full_model)){ + returnV <- list(X = test_doses, Y = exp(log(f)+ 0.5*exp(fit$parameters[length(fit$parameters)])))#lognormal mean # nolint + }else{ + returnV <- list(X = test_doses, Y = f) + } + return(returnV) +} \ No newline at end of file diff --git a/R/prior_classes.R b/R/prior_classes.R index 702c33f..44c5f4c 100644 --- a/R/prior_classes.R +++ b/R/prior_classes.R @@ -22,6 +22,22 @@ #OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +#' Specify a normal prior for a ToxicR Bayesian model fit. +#' @title normprior - create a normal prior object +#' @param mean mean of the prior +#' @param sd sd of the prior distribution. +#' @param lb lower bound on the distribution. Necessary for the optimization algorithms, +#' To make sure it is a fully normal prior, make lb small relative to the mean/sd. +#' @param ub Upper bound on the distribution. Necessary for the optimization algorithms, +#' To make sure it is a fully normal prior, make ub large relative to the mean/sd. +#' @return a normal prior model object +#' @examples +#' # Normal Prior with mean 0,sd-1 +#' normprior(mean = 0, sd = 1, lb = -1e4, ub=1e4) +#' +#' # Truncated Normal prior, Truncated below at 0 +#' normprior(mean = 0, sd = 1, lb = 0, ub=1e4) +#' normprior<-function(mean = 0, sd = 1, lb = -100,ub=100){ if (ub < lb){ stop("Upper Bound must be greater than lower bound") @@ -31,6 +47,22 @@ normprior<-function(mean = 0, sd = 1, lb = -100,ub=100){ return(retValue) } +#' Specify a log-normal prior for a ToxicR Bayesian model fit. +#' @title lnormprior - create a lognormal prior. +#' @param mean log-mean of the prior distribution. +#' @param sd log-sd of the prior distribution. +#' @param lb lower bound on the distribution. Necessary for the optimization algorithms, +#' To make sure it is a fully normal prior, make lb small relative to the mean/sd. +#' @param ub Upper bound on the distribution. Necessary for the optimization algorithms, +#' To make sure it is a fully normal prior, make ub large relative to the mean/sd. +#' @return a normal prior model object +#' @examples +#' # Log-Normal Prior with mean 0,sd-1 +#' lnormprior(mean = 0, sd = 1, lb = -1e4, ub=1e4) +#' +#' # Truncated Log-Normal prior, Truncated below at 1 +#' lnormprior(mean = 0, sd = 1, lb = 1, ub=1e4) +#' lnormprior<-function(mean = 0, sd = 1, lb = -100,ub=100){ if (lb < 0){ lb = 0 @@ -45,21 +77,35 @@ lnormprior<-function(mean = 0, sd = 1, lb = -100,ub=100){ return(retValue) } -print.BMDprior<-function(prior){ - - if(prior[1] == 1){ - cat(sprintf("Prior: Normal(mu = %1.2f, sd = %1.3f) 1[%1.2f,%1.2f]\n",prior[2], - prior[3],prior[4],prior[5])) - return(); - } - if (prior[1] == 2){ - cat(sprintf("Prior: Log-Normal(log-mu = %1.2f, log-sd = %1.3f) 1[%1.2f,%1.2f]\n",prior[2], - prior[3],prior[4],prior[5])) - return(); - } - cat("Distribution not specified.") -} +# print.BMDprior<-function(x, ...){ +# prior = x +# if(prior[1] == 1){ +# cat(sprintf("Prior: Normal(mu = %1.2f, sd = %1.3f) 1[%1.2f,%1.2f]\n",prior[2], +# prior[3],prior[4],prior[5])) +# return(); +# } +# if (prior[1] == 2){ +# cat(sprintf("Prior: Log-Normal(log-mu = %1.2f, log-sd = %1.3f) 1[%1.2f,%1.2f]\n",prior[2], +# prior[3],prior[4],prior[5])) +# return(); +# } +# cat("Distribution not specified.") +# } +#' @title create_prior_lists .. Given priors +#' created using the ToxicR prior functions, create a list of priors +#' for a model. +#' @param x1 First Prior +#' @param x2 Second Prior +#' @param ... Aditional arguments +#' @return new BMDprior list. +#' +#' @examples +#' plist<- create_prior_list(normprior(0,0.1,-100,100), # a +#' normprior(0,1, -1e2,1e2), # b +#' lnormprior(1,0.2,0,18), #k +#' normprior(0,1,-18,18)) +#' create_prior_list <- function(x1,x2,...){ cl <- match.call() mf <- as.list(match.call(expand.dots = TRUE))[-1] @@ -75,7 +121,8 @@ create_prior_list <- function(x1,x2,...){ return(Y) } -combine_prior_lists<-function(p1,p2){ + +.combine_prior_lists<-function(p1,p2){ if (as.character(class(p1)) == "BMDprior"){ x1 <- as.matrix(p1[ ,,drop=F]) @@ -96,7 +143,8 @@ combine_prior_lists<-function(p1,p2){ return(retval) } -.print.BMD_Bayes_model <- function(priors){ +.print.BMD_Bayes_model <- function(x, ...){ + priors = x X = priors[[1]] if (!is.null(priors$model)){ cat(priors$model," Parameter Priors\n") @@ -125,10 +173,9 @@ combine_prior_lists<-function(p1,p2){ } -#################################################33 -# bayesian_prior_dich(model,variance) -################################################## -bayesian_prior_continuous_default <- function(model,variance,degree=2){ + +.bayesian_prior_continuous_default <- function(model,distribution,degree=2){ + variance = distribution dmodel = which(model==c("hill","exp-3","exp-5","power","polynomial")) dvariance = which(variance == c("normal","normal-ncv","lognormal")) @@ -210,17 +257,17 @@ bayesian_prior_continuous_default <- function(model,variance,degree=2){ if (dvariance == 1){ prior <- create_prior_list(normprior(0,5,-100,100)) for (ii in 1:degree){ - prior <- combine_prior_lists(prior, + prior <- .combine_prior_lists(prior, normprior(0,5,-100,100)) } - prior <- combine_prior_lists(prior, create_prior_list(normprior (0,1,-18,18))) + prior <- .combine_prior_lists(prior, create_prior_list(normprior (0,1,-18,18))) } else if (dvariance == 2){ prior <- create_prior_list(normprior(0,5,-100,100)) for (ii in 1:degree){ - prior <- combine_prior_lists(prior, + prior <- .combine_prior_lists(prior, normprior(0,5,-100,100)) } - prior <- combine_prior_lists(prior, + prior <- .combine_prior_lists(prior, create_prior_list(lnormprior(0,1,0,100), normprior (0,1,-18,18))) } else if (dvariance == 3){ @@ -234,7 +281,7 @@ bayesian_prior_continuous_default <- function(model,variance,degree=2){ ############################################################## #Standard Dichtomous ############################################################## -bayesian_prior_dich <- function(model,degree=2){ +.bayesian_prior_dich <- function(model,degree=2){ dmodel = which(model==c("hill","gamma","logistic", "log-logistic", "log-probit" ,"multistage" ,"probit", "qlinear","weibull")) @@ -275,7 +322,7 @@ bayesian_prior_dich <- function(model,degree=2){ degree = floor(degree) if (degree >= 2){#make sure it is a positive degree for (ii in (2:degree)){ - startP <- combine_prior_lists(startP,lnormprior(0,1,0,1e6)) + startP <- .combine_prior_lists(startP,lnormprior(0,1,0,1e6)) } } prior <- startP @@ -304,7 +351,7 @@ bayesian_prior_dich <- function(model,degree=2){ #################################################33 # bayesian_prior_dich(model,variance) ################################################## -MLE_bounds_continuous <- function(model,variance,degree=2, is_increasing){ +.MLE_bounds_continuous <- function(model,variance,degree=2, is_increasing){ dmodel = which(model==c("hill","exp-3","exp-5","power","polynomial")) dvariance = which(variance == c("normal","normal-ncv","lognormal")) @@ -317,13 +364,13 @@ MLE_bounds_continuous <- function(model,variance,degree=2, is_increasing){ for (ii in 1:degree){ if(is_increasing){ - prior <- combine_prior_lists(prior, normprior(0,5,0,18)) + prior <- .combine_prior_lists(prior, normprior(0,5,0,18)) } else{ - prior <- combine_prior_lists(prior, normprior(0,5,-18,0)) + prior <- .combine_prior_lists(prior, normprior(0,5,-18,0)) } } - prior <- combine_prior_lists(prior, create_prior_list(normprior (0,1,-18,18))) + prior <- .combine_prior_lists(prior, create_prior_list(normprior (0,1,-18,18))) prior[[1]][,1] = 0 return(prior) } @@ -332,9 +379,9 @@ MLE_bounds_continuous <- function(model,variance,degree=2, is_increasing){ prior <- create_prior_list(normprior(0,5,0,1000)) for (ii in 1:degree){ - prior <- combine_prior_lists(prior,normprior(0,5,-10000,10000)) + prior <- .combine_prior_lists(prior,normprior(0,5,-10000,10000)) } - prior <- combine_prior_lists(prior, + prior <- .combine_prior_lists(prior, create_prior_list(lnormprior(0,1,0,100), normprior (0,1,-18,18))) prior[[1]][,1] = 0 @@ -353,34 +400,34 @@ MLE_bounds_continuous <- function(model,variance,degree=2, is_increasing){ if (dvariance == 1){ #normal prior <- create_prior_list(normprior(0,1,-100,100)) if(is_increasing){ - prior <- combine_prior_lists(prior,normprior(0,2,0,100)) + prior <- .combine_prior_lists(prior,normprior(0,2,0,100)) } else { - prior <- combine_prior_lists(prior,normprior(0,2,-100,0)) + prior <- .combine_prior_lists(prior,normprior(0,2,-100,0)) } - prior <- combine_prior_lists(prior,lnormprior(0,1,0,5)) - prior <- combine_prior_lists(prior,lnormprior(1,1.2,1,18)) - prior <- combine_prior_lists(prior,normprior(0,1,-18,18)) + prior <- .combine_prior_lists(prior,lnormprior(0,1,0,5)) + prior <- .combine_prior_lists(prior,lnormprior(1,1.2,1,18)) + prior <- .combine_prior_lists(prior,normprior(0,1,-18,18)) } else if(dvariance == 2){ #normal ncv prior <- create_prior_list(normprior(0,1,-100,100)) if(is_increasing){ - prior <- combine_prior_lists(prior,normprior(0,2,0,100)) + prior <- .combine_prior_lists(prior,normprior(0,2,0,100)) } else { - prior <- combine_prior_lists(prior,normprior(0,2,-100,0)) + prior <- .combine_prior_lists(prior,normprior(0,2,-100,0)) } - prior <- combine_prior_lists(prior,normprior(0,1,0,5)) - prior <- combine_prior_lists(prior,lnormprior(log(1.2),1,1,18)) - prior <- combine_prior_lists(prior,normprior(0,2,-18,18)) - prior <- combine_prior_lists(prior,normprior(0,2,-18,18)) + prior <- .combine_prior_lists(prior,normprior(0,1,0,5)) + prior <- .combine_prior_lists(prior,lnormprior(log(1.2),1,1,18)) + prior <- .combine_prior_lists(prior,normprior(0,2,-18,18)) + prior <- .combine_prior_lists(prior,normprior(0,2,-18,18)) } else if (dvariance == 3){ #log normal prior <- create_prior_list(normprior(0,1,-100,100)) if(is_increasing){ - prior <- combine_prior_lists(prior,normprior(0,2,0,100)) + prior <- .combine_prior_lists(prior,normprior(0,2,0,100)) } else { - prior <- combine_prior_lists(prior,normprior(0,2,-100,0)) + prior <- .combine_prior_lists(prior,normprior(0,2,-100,0)) } - prior <- combine_prior_lists(prior,lnormprior(0 ,1,0,5)) - prior <- combine_prior_lists(prior,lnormprior(0,1,0,18)) - prior <- combine_prior_lists(prior,normprior(0,1,-18,18)) + prior <- .combine_prior_lists(prior,lnormprior(0 ,1,0,5)) + prior <- .combine_prior_lists(prior,lnormprior(0,1,0,18)) + prior <- .combine_prior_lists(prior,normprior(0,1,-18,18)) } } diff --git a/R/summary_continuous.R b/R/summary_continuous.R index 97d55b4..0af9e73 100644 --- a/R/summary_continuous.R +++ b/R/summary_continuous.R @@ -17,11 +17,30 @@ #CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE #OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. -.summary_continuous_max<-function(model,alpha=0.05){ - returnV <- list() - if (alpha < 0 || alpha > 0.5){ - warning("Specified BMD alpha-level is outside of [0,0.5] defaulting to 0.05") + +.evaluate_alpha <- function(...){ + args <- list(...) + + cl <- match.call() + ev <- match("alpha",names(cl)) + if (is.na(ev)){ + alpha = 0.05 + }else{ + alpha = args$alpha + if ( (alpha <= 0) || alpha > 0.5){ + stop("alpha must be in (0,0.5]") + } } + + return(alpha) +} + + +.summary_continuous_max<-function(object,...){ + model = object + returnV <- list() + alpha = .evaluate_alpha(...) + if (is.null(model$prior)){ returnV$fit_method <- "MLE" returnV$prior <- NA @@ -49,8 +68,8 @@ return(returnV) } -.print_summary_continuous_max<-function(s_fit){ - +.print_summary_continuous_max<-function(x, ...){ # nolint + s_fit <- x if (grepl("MLE",s_fit$fit_method)){ cat(sprintf("Summary of single model fit (%s) using ToxicR\n","MLE")) @@ -58,7 +77,7 @@ }else{ cat(sprintf("Summary of single model fit (%s) using ToxicR\n\n","Bayesian-MAP")) s_fit$GOF[,2] = round(s_fit$GOF[,2],2) - print(s_fit$prior) + # print(s_fit$prior) } cat("\n") @@ -72,4 +91,117 @@ s_fit$GOF[,3] <- round(s_fit$GOF[,3],3) rownames(s_fit$GOF) <- c("Test: Mean Adequate","Test: Mean/Variance Adequate") print(s_fit$GOF) -} \ No newline at end of file +} + + +.summary_continuous_mcmc<-function(object,...){ + model = object + returnV <- list() + + alpha = .evaluate_alpha(...) + + returnV$fit_method <- "Bayesian:MCMC" + returnV$prior <- model$prior + returnV$fit <- model$full_model + + temp_function <- splinefun(model$bmd_dist[,2],model$bmd_dist[,1],method="monoH.FC") + returnV$BMD <- temp_function(1-c(1-alpha,0.5,alpha)) + names(returnV$BMD) <- c("BMDL","BMD","BMDU") + returnV$alpha <- alpha + returnV$eff_size <- coda::effectiveSize(model$mcmc_result$BMD_samples) + returnV$geweke_z <- coda::geweke.diag(coda::as.mcmc(model$mcmc_result$BMD_samples),frac1 = 0.3, frac2 = 0.4)$z + class(returnV) <- "summary_mcmc" + return(returnV) +} + +.print_summary_continuous_mcmc<-function(x, ...){ + s_fit = x + + cat(sprintf("Summary of single model fit (%s) using ToxicR\n","MCMC")) + cat(s_fit$fit,"\n") + + cat("\n") + + cat("BMD: ") + cat(sprintf("%1.2f (%1.2f, %1.2f) %1.1f%% CI\n",s_fit$BMD[2],s_fit$BMD[1],s_fit$BMD[3],100*(1-2*s_fit$alpha))) + cat("\n") + cat("Convergence Diagnostics on BMD\n") + cat("--------------------------------------------------\n") + cat(sprintf("Effective Sample Size: %1.2f\n\n", s_fit$eff_size) ) + cat(sprintf("Geweke Z-score that mean of first 30%% of \nMCMC chain is different from last 40%%\nZ-Score: %1.3f P-value %1.3f\n", + s_fit$geweke_z,2*pnorm(abs(s_fit$geweke_z),lower.tail=F))) + +} + +.summary_ma_max<-function(object, ...){ + model = object + alpha = .evaluate_alpha(...) + warn = getOption("warn") + options(warn=-1) + returnV <- list() + + returnV$fit_method <- "Bayesian:MCMC" + returnV$fit_table <- data.frame(post_p = round(model$posterior_probs,3)) + tmp_idx <- grep("Individual",names(model)) + + temp_mfit <- rep(" ",length(tmp_idx)) #model name + temp_BMD <- rep(" ",length(tmp_idx)) #bmd + temp_BMDL <- rep(" ",length(tmp_idx)) #bmdl + temp_BMDU <- rep(" ",length(tmp_idx)) #bmdu + + for (ii in tmp_idx){ + tmp_fit <- model[[ii]] + data_temp = tmp_fit$bmd_dist + dist = data_temp[!is.infinite(data_temp[,1]) & !is.na(data_temp[,1]),] + dist = data_temp[!is.nan(data_temp[,1])] + if (length(dist)>10 & !identical(dist, numeric(0))){ + temp_function <- splinefun(data_temp[,2],data_temp[,1],method="monoH.FC") + temp_bmds <- temp_function(1-c(1-alpha,0.5,alpha)) + temp_mfit[ii] <- sub("Model: ","",tmp_fit$full_model) + temp_BMD[ii] <- round(temp_bmds[2],3) + temp_BMDL[ii] <- round(temp_bmds[1],3) + temp_BMDU[ii] <- round(temp_bmds[3],3) + }else{ + temp_mfit[ii] <- sub("Model: ","",tmp_fit$full_model) + temp_BMD[ii] <- NA + temp_BMDL[ii] <- NA + temp_BMDU[ii] <- NA + } + } + + returnV$fit_table$model_names = temp_mfit + returnV$fit_table$BMD = temp_BMD + returnV$fit_table$BMDL = temp_BMDL + returnV$fit_table$BMDU = temp_BMDU + + tmp_idx = order(returnV$fit_table$post_p,decreasing=T) + returnV$fit_table = returnV$fit_table[tmp_idx,c(2,3,4,5,1)] + + + temp_function <- splinefun(model$ma_bmd[,2],model$ma_bmd[,1],method="monoH.FC") + returnV$BMD <- temp_function(1-c(1-alpha,0.5,alpha)) + names(returnV$BMD) <- c("BMDL","BMD","BMDU") + returnV$alpha <- alpha + options(warn=warn) + class(returnV) <- "ma_summary_max" + return(returnV) +} + +.print_summary_ma_max<-function(x, ...){ # nolint + s_fit <- x + cat("Summary of single MA BMD\n\n") + cat("Individual Model BMDS\n") + cat(paste("Model",strrep(' ',34),sep=''),"\t\t BMD (BMDL, BMDU)\tPr(M|Data)\n") + cat("___________________________________________________________________________________________\n") + for (ii in 1:nrow(s_fit$fit_table)){ + tmp_length = nchar(s_fit$fit_table[ii,1]) + pad <- paste(substr(s_fit$fit_table[ii,1],1,38),strrep(" ",39-tmp_length),sep="") + cat(sprintf("%s\t\t\t%1.2f (%1.2f ,%1.2f) \t %1.3f\n",pad,as.numeric(s_fit$fit_table[ii,2]), + as.numeric(s_fit$fit_table[ii,3]),as.numeric(s_fit$fit_table[ii,4]),as.numeric(s_fit$fit_table[ii,5]))) + } + cat("___________________________________________________________________________________________\n") + + cat("Model Average BMD: ") + cat(sprintf("%1.2f (%1.2f, %1.2f) %1.1f%% CI\n",s_fit$BMD[2],s_fit$BMD[1],s_fit$BMD[3], + 100*(1-2*s_fit$alpha))) +} diff --git a/R/summary_dichotomous.R b/R/summary_dichotomous.R index d531c0b..12e8f23 100644 --- a/R/summary_dichotomous.R +++ b/R/summary_dichotomous.R @@ -17,11 +17,10 @@ #CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE #OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. -.summary_dichotomous_max<-function(model,alpha=0.05){ +.summary_dichotomous_max<-function(object,...){ + model <- object returnV <- list() - if (alpha < 0 || alpha > 0.5){ - warning("Specified BMD alpha-level is outside of [0,0.5] defaulting to 0.05") - } + alpha = .evaluate_alpha(...) if (is.null(model$prior)){ returnV$fit_method <- "MLE" returnV$prior <- NA @@ -43,15 +42,16 @@ return(returnV) } -.print_summary_dichotomous_max<-function(s_fit){ - + +.print_summary_dichotomous_max<-function(x, ...){ # nolint + s_fit <- x if (grepl("MLE",s_fit$fit_method)){ cat(sprintf("Summary of single model fit (%s) using ToxicR\n","MLE")) cat(s_fit$fit,"\n") }else{ cat(sprintf("Summary of single model fit (%s) using ToxicR\n\n","Bayesian-MAP")) - print(s_fit$prior) + # print(s_fit$prior) } cat("\n") diff --git a/R/sysdata.rda b/R/sysdata.rda new file mode 100644 index 0000000..803285c Binary files /dev/null and b/R/sysdata.rda differ diff --git a/cleanup b/cleanup new file mode 100755 index 0000000..a92a641 --- /dev/null +++ b/cleanup @@ -0,0 +1,10 @@ +#!/bin/sh + +rm -f src/*.o +rm -f src/*.so +rm -f src/polyK/*.o +rm -f src/code_base/*.o +rm -f src/Makevars +rm -f config.* +rm -rf autom4te.cache +rm -fr src/nlopt config.log config.status \ No newline at end of file diff --git a/configure b/configure new file mode 100755 index 0000000..c188c7d --- /dev/null +++ b/configure @@ -0,0 +1,4686 @@ +#! /bin/sh +# Guess values for system-dependent variables and create Makefiles. +# Generated by GNU Autoconf 2.71 for ToxicR 1.0.1. +# +# +# Copyright (C) 1992-1996, 1998-2017, 2020-2021 Free Software Foundation, +# Inc. +# +# +# This configure script is free software; the Free Software Foundation +# gives unlimited permission to copy, distribute and modify it. +## -------------------- ## +## M4sh Initialization. ## +## -------------------- ## + +# Be more Bourne compatible +DUALCASE=1; export DUALCASE # for MKS sh +as_nop=: +if test ${ZSH_VERSION+y} && (emulate sh) >/dev/null 2>&1 +then : + emulate sh + NULLCMD=: + # Pre-4.2 versions of Zsh do word splitting on ${1+"$@"}, which + # is contrary to our usage. Disable this feature. + alias -g '${1+"$@"}'='"$@"' + setopt NO_GLOB_SUBST +else $as_nop + case `(set -o) 2>/dev/null` in #( + *posix*) : + set -o posix ;; #( + *) : + ;; +esac +fi + + + +# Reset variables that may have inherited troublesome values from +# the environment. + +# IFS needs to be set, to space, tab, and newline, in precisely that order. +# (If _AS_PATH_WALK were called with IFS unset, it would have the +# side effect of setting IFS to empty, thus disabling word splitting.) +# Quoting is to prevent editors from complaining about space-tab. +as_nl=' +' +export as_nl +IFS=" "" $as_nl" + +PS1='$ ' +PS2='> ' +PS4='+ ' + +# Ensure predictable behavior from utilities with locale-dependent output. +LC_ALL=C +export LC_ALL +LANGUAGE=C +export LANGUAGE + +# We cannot yet rely on "unset" to work, but we need these variables +# to be unset--not just set to an empty or harmless value--now, to +# avoid bugs in old shells (e.g. pre-3.0 UWIN ksh). This construct +# also avoids known problems related to "unset" and subshell syntax +# in other old shells (e.g. bash 2.01 and pdksh 5.2.14). +for as_var in BASH_ENV ENV MAIL MAILPATH CDPATH +do eval test \${$as_var+y} \ + && ( (unset $as_var) || exit 1) >/dev/null 2>&1 && unset $as_var || : +done + +# Ensure that fds 0, 1, and 2 are open. +if (exec 3>&0) 2>/dev/null; then :; else exec 0&1) 2>/dev/null; then :; else exec 1>/dev/null; fi +if (exec 3>&2) ; then :; else exec 2>/dev/null; fi + +# The user is always right. +if ${PATH_SEPARATOR+false} :; then + PATH_SEPARATOR=: + (PATH='/bin;/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 && { + (PATH='/bin:/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 || + PATH_SEPARATOR=';' + } +fi + + +# Find who we are. Look in the path if we contain no directory separator. +as_myself= +case $0 in #(( + *[\\/]* ) as_myself=$0 ;; + *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + case $as_dir in #((( + '') as_dir=./ ;; + */) ;; + *) as_dir=$as_dir/ ;; + esac + test -r "$as_dir$0" && as_myself=$as_dir$0 && break + done +IFS=$as_save_IFS + + ;; +esac +# We did not find ourselves, most probably we were run as `sh COMMAND' +# in which case we are not to be found in the path. +if test "x$as_myself" = x; then + as_myself=$0 +fi +if test ! -f "$as_myself"; then + printf "%s\n" "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2 + exit 1 +fi + + +# Use a proper internal environment variable to ensure we don't fall + # into an infinite loop, continuously re-executing ourselves. + if test x"${_as_can_reexec}" != xno && test "x$CONFIG_SHELL" != x; then + _as_can_reexec=no; export _as_can_reexec; + # We cannot yet assume a decent shell, so we have to provide a +# neutralization value for shells without unset; and this also +# works around shells that cannot unset nonexistent variables. +# Preserve -v and -x to the replacement shell. +BASH_ENV=/dev/null +ENV=/dev/null +(unset BASH_ENV) >/dev/null 2>&1 && unset BASH_ENV ENV +case $- in # (((( + *v*x* | *x*v* ) as_opts=-vx ;; + *v* ) as_opts=-v ;; + *x* ) as_opts=-x ;; + * ) as_opts= ;; +esac +exec $CONFIG_SHELL $as_opts "$as_myself" ${1+"$@"} +# Admittedly, this is quite paranoid, since all the known shells bail +# out after a failed `exec'. +printf "%s\n" "$0: could not re-execute with $CONFIG_SHELL" >&2 +exit 255 + fi + # We don't want this to propagate to other subprocesses. + { _as_can_reexec=; unset _as_can_reexec;} +if test "x$CONFIG_SHELL" = x; then + as_bourne_compatible="as_nop=: +if test \${ZSH_VERSION+y} && (emulate sh) >/dev/null 2>&1 +then : + emulate sh + NULLCMD=: + # Pre-4.2 versions of Zsh do word splitting on \${1+\"\$@\"}, which + # is contrary to our usage. Disable this feature. + alias -g '\${1+\"\$@\"}'='\"\$@\"' + setopt NO_GLOB_SUBST +else \$as_nop + case \`(set -o) 2>/dev/null\` in #( + *posix*) : + set -o posix ;; #( + *) : + ;; +esac +fi +" + as_required="as_fn_return () { (exit \$1); } +as_fn_success () { as_fn_return 0; } +as_fn_failure () { as_fn_return 1; } +as_fn_ret_success () { return 0; } +as_fn_ret_failure () { return 1; } + +exitcode=0 +as_fn_success || { exitcode=1; echo as_fn_success failed.; } +as_fn_failure && { exitcode=1; echo as_fn_failure succeeded.; } +as_fn_ret_success || { exitcode=1; echo as_fn_ret_success failed.; } +as_fn_ret_failure && { exitcode=1; echo as_fn_ret_failure succeeded.; } +if ( set x; as_fn_ret_success y && test x = \"\$1\" ) +then : + +else \$as_nop + exitcode=1; echo positional parameters were not saved. +fi +test x\$exitcode = x0 || exit 1 +blah=\$(echo \$(echo blah)) +test x\"\$blah\" = xblah || exit 1 +test -x / || exit 1" + as_suggested=" as_lineno_1=";as_suggested=$as_suggested$LINENO;as_suggested=$as_suggested" as_lineno_1a=\$LINENO + as_lineno_2=";as_suggested=$as_suggested$LINENO;as_suggested=$as_suggested" as_lineno_2a=\$LINENO + eval 'test \"x\$as_lineno_1'\$as_run'\" != \"x\$as_lineno_2'\$as_run'\" && + test \"x\`expr \$as_lineno_1'\$as_run' + 1\`\" = \"x\$as_lineno_2'\$as_run'\"' || exit 1" + if (eval "$as_required") 2>/dev/null +then : + as_have_required=yes +else $as_nop + as_have_required=no +fi + if test x$as_have_required = xyes && (eval "$as_suggested") 2>/dev/null +then : + +else $as_nop + as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +as_found=false +for as_dir in /bin$PATH_SEPARATOR/usr/bin$PATH_SEPARATOR$PATH +do + IFS=$as_save_IFS + case $as_dir in #((( + '') as_dir=./ ;; + */) ;; + *) as_dir=$as_dir/ ;; + esac + as_found=: + case $as_dir in #( + /*) + for as_base in sh bash ksh sh5; do + # Try only shells that exist, to save several forks. + as_shell=$as_dir$as_base + if { test -f "$as_shell" || test -f "$as_shell.exe"; } && + as_run=a "$as_shell" -c "$as_bourne_compatible""$as_required" 2>/dev/null +then : + CONFIG_SHELL=$as_shell as_have_required=yes + if as_run=a "$as_shell" -c "$as_bourne_compatible""$as_suggested" 2>/dev/null +then : + break 2 +fi +fi + done;; + esac + as_found=false +done +IFS=$as_save_IFS +if $as_found +then : + +else $as_nop + if { test -f "$SHELL" || test -f "$SHELL.exe"; } && + as_run=a "$SHELL" -c "$as_bourne_compatible""$as_required" 2>/dev/null +then : + CONFIG_SHELL=$SHELL as_have_required=yes +fi +fi + + + if test "x$CONFIG_SHELL" != x +then : + export CONFIG_SHELL + # We cannot yet assume a decent shell, so we have to provide a +# neutralization value for shells without unset; and this also +# works around shells that cannot unset nonexistent variables. +# Preserve -v and -x to the replacement shell. +BASH_ENV=/dev/null +ENV=/dev/null +(unset BASH_ENV) >/dev/null 2>&1 && unset BASH_ENV ENV +case $- in # (((( + *v*x* | *x*v* ) as_opts=-vx ;; + *v* ) as_opts=-v ;; + *x* ) as_opts=-x ;; + * ) as_opts= ;; +esac +exec $CONFIG_SHELL $as_opts "$as_myself" ${1+"$@"} +# Admittedly, this is quite paranoid, since all the known shells bail +# out after a failed `exec'. +printf "%s\n" "$0: could not re-execute with $CONFIG_SHELL" >&2 +exit 255 +fi + + if test x$as_have_required = xno +then : + printf "%s\n" "$0: This script requires a shell more modern than all" + printf "%s\n" "$0: the shells that I found on your system." + if test ${ZSH_VERSION+y} ; then + printf "%s\n" "$0: In particular, zsh $ZSH_VERSION has bugs and should" + printf "%s\n" "$0: be upgraded to zsh 4.3.4 or later." + else + printf "%s\n" "$0: Please tell bug-autoconf@gnu.org about your system, +$0: including any error possibly output before this +$0: message. Then install a modern shell, or manually run +$0: the script under such a shell if you do have one." + fi + exit 1 +fi +fi +fi +SHELL=${CONFIG_SHELL-/bin/sh} +export SHELL +# Unset more variables known to interfere with behavior of common tools. +CLICOLOR_FORCE= GREP_OPTIONS= +unset CLICOLOR_FORCE GREP_OPTIONS + +## --------------------- ## +## M4sh Shell Functions. ## +## --------------------- ## +# as_fn_unset VAR +# --------------- +# Portably unset VAR. +as_fn_unset () +{ + { eval $1=; unset $1;} +} +as_unset=as_fn_unset + + +# as_fn_set_status STATUS +# ----------------------- +# Set $? to STATUS, without forking. +as_fn_set_status () +{ + return $1 +} # as_fn_set_status + +# as_fn_exit STATUS +# ----------------- +# Exit the shell with STATUS, even in a "trap 0" or "set -e" context. +as_fn_exit () +{ + set +e + as_fn_set_status $1 + exit $1 +} # as_fn_exit +# as_fn_nop +# --------- +# Do nothing but, unlike ":", preserve the value of $?. +as_fn_nop () +{ + return $? +} +as_nop=as_fn_nop + +# as_fn_mkdir_p +# ------------- +# Create "$as_dir" as a directory, including parents if necessary. +as_fn_mkdir_p () +{ + + case $as_dir in #( + -*) as_dir=./$as_dir;; + esac + test -d "$as_dir" || eval $as_mkdir_p || { + as_dirs= + while :; do + case $as_dir in #( + *\'*) as_qdir=`printf "%s\n" "$as_dir" | sed "s/'/'\\\\\\\\''/g"`;; #'( + *) as_qdir=$as_dir;; + esac + as_dirs="'$as_qdir' $as_dirs" + as_dir=`$as_dirname -- "$as_dir" || +$as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ + X"$as_dir" : 'X\(//\)[^/]' \| \ + X"$as_dir" : 'X\(//\)$' \| \ + X"$as_dir" : 'X\(/\)' \| . 2>/dev/null || +printf "%s\n" X"$as_dir" | + sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ + s//\1/ + q + } + /^X\(\/\/\)[^/].*/{ + s//\1/ + q + } + /^X\(\/\/\)$/{ + s//\1/ + q + } + /^X\(\/\).*/{ + s//\1/ + q + } + s/.*/./; q'` + test -d "$as_dir" && break + done + test -z "$as_dirs" || eval "mkdir $as_dirs" + } || test -d "$as_dir" || as_fn_error $? "cannot create directory $as_dir" + + +} # as_fn_mkdir_p + +# as_fn_executable_p FILE +# ----------------------- +# Test if FILE is an executable regular file. +as_fn_executable_p () +{ + test -f "$1" && test -x "$1" +} # as_fn_executable_p +# as_fn_append VAR VALUE +# ---------------------- +# Append the text in VALUE to the end of the definition contained in VAR. Take +# advantage of any shell optimizations that allow amortized linear growth over +# repeated appends, instead of the typical quadratic growth present in naive +# implementations. +if (eval "as_var=1; as_var+=2; test x\$as_var = x12") 2>/dev/null +then : + eval 'as_fn_append () + { + eval $1+=\$2 + }' +else $as_nop + as_fn_append () + { + eval $1=\$$1\$2 + } +fi # as_fn_append + +# as_fn_arith ARG... +# ------------------ +# Perform arithmetic evaluation on the ARGs, and store the result in the +# global $as_val. Take advantage of shells that can avoid forks. The arguments +# must be portable across $(()) and expr. +if (eval "test \$(( 1 + 1 )) = 2") 2>/dev/null +then : + eval 'as_fn_arith () + { + as_val=$(( $* )) + }' +else $as_nop + as_fn_arith () + { + as_val=`expr "$@" || test $? -eq 1` + } +fi # as_fn_arith + +# as_fn_nop +# --------- +# Do nothing but, unlike ":", preserve the value of $?. +as_fn_nop () +{ + return $? +} +as_nop=as_fn_nop + +# as_fn_error STATUS ERROR [LINENO LOG_FD] +# ---------------------------------------- +# Output "`basename $0`: error: ERROR" to stderr. If LINENO and LOG_FD are +# provided, also output the error to LOG_FD, referencing LINENO. Then exit the +# script with STATUS, using 1 if that was 0. +as_fn_error () +{ + as_status=$1; test $as_status -eq 0 && as_status=1 + if test "$4"; then + as_lineno=${as_lineno-"$3"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: $2" >&$4 + fi + printf "%s\n" "$as_me: error: $2" >&2 + as_fn_exit $as_status +} # as_fn_error + +if expr a : '\(a\)' >/dev/null 2>&1 && + test "X`expr 00001 : '.*\(...\)'`" = X001; then + as_expr=expr +else + as_expr=false +fi + +if (basename -- /) >/dev/null 2>&1 && test "X`basename -- / 2>&1`" = "X/"; then + as_basename=basename +else + as_basename=false +fi + +if (as_dir=`dirname -- /` && test "X$as_dir" = X/) >/dev/null 2>&1; then + as_dirname=dirname +else + as_dirname=false +fi + +as_me=`$as_basename -- "$0" || +$as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \ + X"$0" : 'X\(//\)$' \| \ + X"$0" : 'X\(/\)' \| . 2>/dev/null || +printf "%s\n" X/"$0" | + sed '/^.*\/\([^/][^/]*\)\/*$/{ + s//\1/ + q + } + /^X\/\(\/\/\)$/{ + s//\1/ + q + } + /^X\/\(\/\).*/{ + s//\1/ + q + } + s/.*/./; q'` + +# Avoid depending upon Character Ranges. +as_cr_letters='abcdefghijklmnopqrstuvwxyz' +as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ' +as_cr_Letters=$as_cr_letters$as_cr_LETTERS +as_cr_digits='0123456789' +as_cr_alnum=$as_cr_Letters$as_cr_digits + + + as_lineno_1=$LINENO as_lineno_1a=$LINENO + as_lineno_2=$LINENO as_lineno_2a=$LINENO + eval 'test "x$as_lineno_1'$as_run'" != "x$as_lineno_2'$as_run'" && + test "x`expr $as_lineno_1'$as_run' + 1`" = "x$as_lineno_2'$as_run'"' || { + # Blame Lee E. McMahon (1931-1989) for sed's syntax. :-) + sed -n ' + p + /[$]LINENO/= + ' <$as_myself | + sed ' + s/[$]LINENO.*/&-/ + t lineno + b + :lineno + N + :loop + s/[$]LINENO\([^'$as_cr_alnum'_].*\n\)\(.*\)/\2\1\2/ + t loop + s/-\n.*// + ' >$as_me.lineno && + chmod +x "$as_me.lineno" || + { printf "%s\n" "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2; as_fn_exit 1; } + + # If we had to re-execute with $CONFIG_SHELL, we're ensured to have + # already done that, so ensure we don't try to do so again and fall + # in an infinite loop. This has already happened in practice. + _as_can_reexec=no; export _as_can_reexec + # Don't try to exec as it changes $[0], causing all sort of problems + # (the dirname of $[0] is not the place where we might find the + # original and so on. Autoconf is especially sensitive to this). + . "./$as_me.lineno" + # Exit status is that of the last command. + exit +} + + +# Determine whether it's possible to make 'echo' print without a newline. +# These variables are no longer used directly by Autoconf, but are AC_SUBSTed +# for compatibility with existing Makefiles. +ECHO_C= ECHO_N= ECHO_T= +case `echo -n x` in #((((( +-n*) + case `echo 'xy\c'` in + *c*) ECHO_T=' ';; # ECHO_T is single tab character. + xy) ECHO_C='\c';; + *) echo `echo ksh88 bug on AIX 6.1` > /dev/null + ECHO_T=' ';; + esac;; +*) + ECHO_N='-n';; +esac + +# For backward compatibility with old third-party macros, we provide +# the shell variables $as_echo and $as_echo_n. New code should use +# AS_ECHO(["message"]) and AS_ECHO_N(["message"]), respectively. +as_echo='printf %s\n' +as_echo_n='printf %s' + + +rm -f conf$$ conf$$.exe conf$$.file +if test -d conf$$.dir; then + rm -f conf$$.dir/conf$$.file +else + rm -f conf$$.dir + mkdir conf$$.dir 2>/dev/null +fi +if (echo >conf$$.file) 2>/dev/null; then + if ln -s conf$$.file conf$$ 2>/dev/null; then + as_ln_s='ln -s' + # ... but there are two gotchas: + # 1) On MSYS, both `ln -s file dir' and `ln file dir' fail. + # 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable. + # In both cases, we have to default to `cp -pR'. + ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe || + as_ln_s='cp -pR' + elif ln conf$$.file conf$$ 2>/dev/null; then + as_ln_s=ln + else + as_ln_s='cp -pR' + fi +else + as_ln_s='cp -pR' +fi +rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file +rmdir conf$$.dir 2>/dev/null + +if mkdir -p . 2>/dev/null; then + as_mkdir_p='mkdir -p "$as_dir"' +else + test -d ./-p && rmdir ./-p + as_mkdir_p=false +fi + +as_test_x='test -x' +as_executable_p=as_fn_executable_p + +# Sed expression to map a string onto a valid CPP name. +as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'" + +# Sed expression to map a string onto a valid variable name. +as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'" + + +test -n "$DJDIR" || exec 7<&0 &1 + +# Name of the host. +# hostname on some systems (SVR3.2, old GNU/Linux) returns a bogus exit status, +# so uname gets run too. +ac_hostname=`(hostname || uname -n) 2>/dev/null | sed 1q` + +# +# Initializations. +# +ac_default_prefix=/usr/local +ac_clean_files= +ac_config_libobj_dir=. +LIBOBJS= +cross_compiling=no +subdirs= +MFLAGS= +MAKEFLAGS= + +# Identity of this package. +PACKAGE_NAME='ToxicR' +PACKAGE_TARNAME='toxicr' +PACKAGE_VERSION='1.0.1' +PACKAGE_STRING='ToxicR 1.0.1' +PACKAGE_BUGREPORT='' +PACKAGE_URL='' + +ac_subst_vars='LTLIBOBJS +LIBOBJS +GSL_LIBS +GSL_CPPFLAGS +NLOPT_CPPFLAGS +SUBDIR_SOURCES +SRC_SOURCES +OPENMP +have_cmake +NLOPT_LIBS +NLOPT_INCLUDE +have_pkg_config +GSL_CONFIG +CPP +OBJEXT +EXEEXT +ac_ct_CC +CPPFLAGS +LDFLAGS +CFLAGS +CC +target_alias +host_alias +build_alias +LIBS +ECHO_T +ECHO_N +ECHO_C +DEFS +mandir +localedir +libdir +psdir +pdfdir +dvidir +htmldir +infodir +docdir +oldincludedir +includedir +runstatedir +localstatedir +sharedstatedir +sysconfdir +datadir +datarootdir +libexecdir +sbindir +bindir +program_transform_name +prefix +exec_prefix +PACKAGE_URL +PACKAGE_BUGREPORT +PACKAGE_STRING +PACKAGE_VERSION +PACKAGE_TARNAME +PACKAGE_NAME +PATH_SEPARATOR +SHELL' +ac_subst_files='' +ac_user_opts=' +enable_option_checking +' + ac_precious_vars='build_alias +host_alias +target_alias +CC +CFLAGS +LDFLAGS +LIBS +CPPFLAGS +CPP' + + +# Initialize some variables set by options. +ac_init_help= +ac_init_version=false +ac_unrecognized_opts= +ac_unrecognized_sep= +# The variables have the same names as the options, with +# dashes changed to underlines. +cache_file=/dev/null +exec_prefix=NONE +no_create= +no_recursion= +prefix=NONE +program_prefix=NONE +program_suffix=NONE +program_transform_name=s,x,x, +silent= +site= +srcdir= +verbose= +x_includes=NONE +x_libraries=NONE + +# Installation directory options. +# These are left unexpanded so users can "make install exec_prefix=/foo" +# and all the variables that are supposed to be based on exec_prefix +# by default will actually change. +# Use braces instead of parens because sh, perl, etc. also accept them. +# (The list follows the same order as the GNU Coding Standards.) +bindir='${exec_prefix}/bin' +sbindir='${exec_prefix}/sbin' +libexecdir='${exec_prefix}/libexec' +datarootdir='${prefix}/share' +datadir='${datarootdir}' +sysconfdir='${prefix}/etc' +sharedstatedir='${prefix}/com' +localstatedir='${prefix}/var' +runstatedir='${localstatedir}/run' +includedir='${prefix}/include' +oldincludedir='/usr/include' +docdir='${datarootdir}/doc/${PACKAGE_TARNAME}' +infodir='${datarootdir}/info' +htmldir='${docdir}' +dvidir='${docdir}' +pdfdir='${docdir}' +psdir='${docdir}' +libdir='${exec_prefix}/lib' +localedir='${datarootdir}/locale' +mandir='${datarootdir}/man' + +ac_prev= +ac_dashdash= +for ac_option +do + # If the previous option needs an argument, assign it. + if test -n "$ac_prev"; then + eval $ac_prev=\$ac_option + ac_prev= + continue + fi + + case $ac_option in + *=?*) ac_optarg=`expr "X$ac_option" : '[^=]*=\(.*\)'` ;; + *=) ac_optarg= ;; + *) ac_optarg=yes ;; + esac + + case $ac_dashdash$ac_option in + --) + ac_dashdash=yes ;; + + -bindir | --bindir | --bindi | --bind | --bin | --bi) + ac_prev=bindir ;; + -bindir=* | --bindir=* | --bindi=* | --bind=* | --bin=* | --bi=*) + bindir=$ac_optarg ;; + + -build | --build | --buil | --bui | --bu) + ac_prev=build_alias ;; + -build=* | --build=* | --buil=* | --bui=* | --bu=*) + build_alias=$ac_optarg ;; + + -cache-file | --cache-file | --cache-fil | --cache-fi \ + | --cache-f | --cache- | --cache | --cach | --cac | --ca | --c) + ac_prev=cache_file ;; + -cache-file=* | --cache-file=* | --cache-fil=* | --cache-fi=* \ + | --cache-f=* | --cache-=* | --cache=* | --cach=* | --cac=* | --ca=* | --c=*) + cache_file=$ac_optarg ;; + + --config-cache | -C) + cache_file=config.cache ;; + + -datadir | --datadir | --datadi | --datad) + ac_prev=datadir ;; + -datadir=* | --datadir=* | --datadi=* | --datad=*) + datadir=$ac_optarg ;; + + -datarootdir | --datarootdir | --datarootdi | --datarootd | --dataroot \ + | --dataroo | --dataro | --datar) + ac_prev=datarootdir ;; + -datarootdir=* | --datarootdir=* | --datarootdi=* | --datarootd=* \ + | --dataroot=* | --dataroo=* | --dataro=* | --datar=*) + datarootdir=$ac_optarg ;; + + -disable-* | --disable-*) + ac_useropt=`expr "x$ac_option" : 'x-*disable-\(.*\)'` + # Reject names that are not valid shell variable names. + expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && + as_fn_error $? "invalid feature name: \`$ac_useropt'" + ac_useropt_orig=$ac_useropt + ac_useropt=`printf "%s\n" "$ac_useropt" | sed 's/[-+.]/_/g'` + case $ac_user_opts in + *" +"enable_$ac_useropt" +"*) ;; + *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--disable-$ac_useropt_orig" + ac_unrecognized_sep=', ';; + esac + eval enable_$ac_useropt=no ;; + + -docdir | --docdir | --docdi | --doc | --do) + ac_prev=docdir ;; + -docdir=* | --docdir=* | --docdi=* | --doc=* | --do=*) + docdir=$ac_optarg ;; + + -dvidir | --dvidir | --dvidi | --dvid | --dvi | --dv) + ac_prev=dvidir ;; + -dvidir=* | --dvidir=* | --dvidi=* | --dvid=* | --dvi=* | --dv=*) + dvidir=$ac_optarg ;; + + -enable-* | --enable-*) + ac_useropt=`expr "x$ac_option" : 'x-*enable-\([^=]*\)'` + # Reject names that are not valid shell variable names. + expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && + as_fn_error $? "invalid feature name: \`$ac_useropt'" + ac_useropt_orig=$ac_useropt + ac_useropt=`printf "%s\n" "$ac_useropt" | sed 's/[-+.]/_/g'` + case $ac_user_opts in + *" +"enable_$ac_useropt" +"*) ;; + *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--enable-$ac_useropt_orig" + ac_unrecognized_sep=', ';; + esac + eval enable_$ac_useropt=\$ac_optarg ;; + + -exec-prefix | --exec_prefix | --exec-prefix | --exec-prefi \ + | --exec-pref | --exec-pre | --exec-pr | --exec-p | --exec- \ + | --exec | --exe | --ex) + ac_prev=exec_prefix ;; + -exec-prefix=* | --exec_prefix=* | --exec-prefix=* | --exec-prefi=* \ + | --exec-pref=* | --exec-pre=* | --exec-pr=* | --exec-p=* | --exec-=* \ + | --exec=* | --exe=* | --ex=*) + exec_prefix=$ac_optarg ;; + + -gas | --gas | --ga | --g) + # Obsolete; use --with-gas. + with_gas=yes ;; + + -help | --help | --hel | --he | -h) + ac_init_help=long ;; + -help=r* | --help=r* | --hel=r* | --he=r* | -hr*) + ac_init_help=recursive ;; + -help=s* | --help=s* | --hel=s* | --he=s* | -hs*) + ac_init_help=short ;; + + -host | --host | --hos | --ho) + ac_prev=host_alias ;; + -host=* | --host=* | --hos=* | --ho=*) + host_alias=$ac_optarg ;; + + -htmldir | --htmldir | --htmldi | --htmld | --html | --htm | --ht) + ac_prev=htmldir ;; + -htmldir=* | --htmldir=* | --htmldi=* | --htmld=* | --html=* | --htm=* \ + | --ht=*) + htmldir=$ac_optarg ;; + + -includedir | --includedir | --includedi | --included | --include \ + | --includ | --inclu | --incl | --inc) + ac_prev=includedir ;; + -includedir=* | --includedir=* | --includedi=* | --included=* | --include=* \ + | --includ=* | --inclu=* | --incl=* | --inc=*) + includedir=$ac_optarg ;; + + -infodir | --infodir | --infodi | --infod | --info | --inf) + ac_prev=infodir ;; + -infodir=* | --infodir=* | --infodi=* | --infod=* | --info=* | --inf=*) + infodir=$ac_optarg ;; + + -libdir | --libdir | --libdi | --libd) + ac_prev=libdir ;; + -libdir=* | --libdir=* | --libdi=* | --libd=*) + libdir=$ac_optarg ;; + + -libexecdir | --libexecdir | --libexecdi | --libexecd | --libexec \ + | --libexe | --libex | --libe) + ac_prev=libexecdir ;; + -libexecdir=* | --libexecdir=* | --libexecdi=* | --libexecd=* | --libexec=* \ + | --libexe=* | --libex=* | --libe=*) + libexecdir=$ac_optarg ;; + + -localedir | --localedir | --localedi | --localed | --locale) + ac_prev=localedir ;; + -localedir=* | --localedir=* | --localedi=* | --localed=* | --locale=*) + localedir=$ac_optarg ;; + + -localstatedir | --localstatedir | --localstatedi | --localstated \ + | --localstate | --localstat | --localsta | --localst | --locals) + ac_prev=localstatedir ;; + -localstatedir=* | --localstatedir=* | --localstatedi=* | --localstated=* \ + | --localstate=* | --localstat=* | --localsta=* | --localst=* | --locals=*) + localstatedir=$ac_optarg ;; + + -mandir | --mandir | --mandi | --mand | --man | --ma | --m) + ac_prev=mandir ;; + -mandir=* | --mandir=* | --mandi=* | --mand=* | --man=* | --ma=* | --m=*) + mandir=$ac_optarg ;; + + -nfp | --nfp | --nf) + # Obsolete; use --without-fp. + with_fp=no ;; + + -no-create | --no-create | --no-creat | --no-crea | --no-cre \ + | --no-cr | --no-c | -n) + no_create=yes ;; + + -no-recursion | --no-recursion | --no-recursio | --no-recursi \ + | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r) + no_recursion=yes ;; + + -oldincludedir | --oldincludedir | --oldincludedi | --oldincluded \ + | --oldinclude | --oldinclud | --oldinclu | --oldincl | --oldinc \ + | --oldin | --oldi | --old | --ol | --o) + ac_prev=oldincludedir ;; + -oldincludedir=* | --oldincludedir=* | --oldincludedi=* | --oldincluded=* \ + | --oldinclude=* | --oldinclud=* | --oldinclu=* | --oldincl=* | --oldinc=* \ + | --oldin=* | --oldi=* | --old=* | --ol=* | --o=*) + oldincludedir=$ac_optarg ;; + + -prefix | --prefix | --prefi | --pref | --pre | --pr | --p) + ac_prev=prefix ;; + -prefix=* | --prefix=* | --prefi=* | --pref=* | --pre=* | --pr=* | --p=*) + prefix=$ac_optarg ;; + + -program-prefix | --program-prefix | --program-prefi | --program-pref \ + | --program-pre | --program-pr | --program-p) + ac_prev=program_prefix ;; + -program-prefix=* | --program-prefix=* | --program-prefi=* \ + | --program-pref=* | --program-pre=* | --program-pr=* | --program-p=*) + program_prefix=$ac_optarg ;; + + -program-suffix | --program-suffix | --program-suffi | --program-suff \ + | --program-suf | --program-su | --program-s) + ac_prev=program_suffix ;; + -program-suffix=* | --program-suffix=* | --program-suffi=* \ + | --program-suff=* | --program-suf=* | --program-su=* | --program-s=*) + program_suffix=$ac_optarg ;; + + -program-transform-name | --program-transform-name \ + | --program-transform-nam | --program-transform-na \ + | --program-transform-n | --program-transform- \ + | --program-transform | --program-transfor \ + | --program-transfo | --program-transf \ + | --program-trans | --program-tran \ + | --progr-tra | --program-tr | --program-t) + ac_prev=program_transform_name ;; + -program-transform-name=* | --program-transform-name=* \ + | --program-transform-nam=* | --program-transform-na=* \ + | --program-transform-n=* | --program-transform-=* \ + | --program-transform=* | --program-transfor=* \ + | --program-transfo=* | --program-transf=* \ + | --program-trans=* | --program-tran=* \ + | --progr-tra=* | --program-tr=* | --program-t=*) + program_transform_name=$ac_optarg ;; + + -pdfdir | --pdfdir | --pdfdi | --pdfd | --pdf | --pd) + ac_prev=pdfdir ;; + -pdfdir=* | --pdfdir=* | --pdfdi=* | --pdfd=* | --pdf=* | --pd=*) + pdfdir=$ac_optarg ;; + + -psdir | --psdir | --psdi | --psd | --ps) + ac_prev=psdir ;; + -psdir=* | --psdir=* | --psdi=* | --psd=* | --ps=*) + psdir=$ac_optarg ;; + + -q | -quiet | --quiet | --quie | --qui | --qu | --q \ + | -silent | --silent | --silen | --sile | --sil) + silent=yes ;; + + -runstatedir | --runstatedir | --runstatedi | --runstated \ + | --runstate | --runstat | --runsta | --runst | --runs \ + | --run | --ru | --r) + ac_prev=runstatedir ;; + -runstatedir=* | --runstatedir=* | --runstatedi=* | --runstated=* \ + | --runstate=* | --runstat=* | --runsta=* | --runst=* | --runs=* \ + | --run=* | --ru=* | --r=*) + runstatedir=$ac_optarg ;; + + -sbindir | --sbindir | --sbindi | --sbind | --sbin | --sbi | --sb) + ac_prev=sbindir ;; + -sbindir=* | --sbindir=* | --sbindi=* | --sbind=* | --sbin=* \ + | --sbi=* | --sb=*) + sbindir=$ac_optarg ;; + + -sharedstatedir | --sharedstatedir | --sharedstatedi \ + | --sharedstated | --sharedstate | --sharedstat | --sharedsta \ + | --sharedst | --shareds | --shared | --share | --shar \ + | --sha | --sh) + ac_prev=sharedstatedir ;; + -sharedstatedir=* | --sharedstatedir=* | --sharedstatedi=* \ + | --sharedstated=* | --sharedstate=* | --sharedstat=* | --sharedsta=* \ + | --sharedst=* | --shareds=* | --shared=* | --share=* | --shar=* \ + | --sha=* | --sh=*) + sharedstatedir=$ac_optarg ;; + + -site | --site | --sit) + ac_prev=site ;; + -site=* | --site=* | --sit=*) + site=$ac_optarg ;; + + -srcdir | --srcdir | --srcdi | --srcd | --src | --sr) + ac_prev=srcdir ;; + -srcdir=* | --srcdir=* | --srcdi=* | --srcd=* | --src=* | --sr=*) + srcdir=$ac_optarg ;; + + -sysconfdir | --sysconfdir | --sysconfdi | --sysconfd | --sysconf \ + | --syscon | --sysco | --sysc | --sys | --sy) + ac_prev=sysconfdir ;; + -sysconfdir=* | --sysconfdir=* | --sysconfdi=* | --sysconfd=* | --sysconf=* \ + | --syscon=* | --sysco=* | --sysc=* | --sys=* | --sy=*) + sysconfdir=$ac_optarg ;; + + -target | --target | --targe | --targ | --tar | --ta | --t) + ac_prev=target_alias ;; + -target=* | --target=* | --targe=* | --targ=* | --tar=* | --ta=* | --t=*) + target_alias=$ac_optarg ;; + + -v | -verbose | --verbose | --verbos | --verbo | --verb) + verbose=yes ;; + + -version | --version | --versio | --versi | --vers | -V) + ac_init_version=: ;; + + -with-* | --with-*) + ac_useropt=`expr "x$ac_option" : 'x-*with-\([^=]*\)'` + # Reject names that are not valid shell variable names. + expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && + as_fn_error $? "invalid package name: \`$ac_useropt'" + ac_useropt_orig=$ac_useropt + ac_useropt=`printf "%s\n" "$ac_useropt" | sed 's/[-+.]/_/g'` + case $ac_user_opts in + *" +"with_$ac_useropt" +"*) ;; + *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--with-$ac_useropt_orig" + ac_unrecognized_sep=', ';; + esac + eval with_$ac_useropt=\$ac_optarg ;; + + -without-* | --without-*) + ac_useropt=`expr "x$ac_option" : 'x-*without-\(.*\)'` + # Reject names that are not valid shell variable names. + expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && + as_fn_error $? "invalid package name: \`$ac_useropt'" + ac_useropt_orig=$ac_useropt + ac_useropt=`printf "%s\n" "$ac_useropt" | sed 's/[-+.]/_/g'` + case $ac_user_opts in + *" +"with_$ac_useropt" +"*) ;; + *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--without-$ac_useropt_orig" + ac_unrecognized_sep=', ';; + esac + eval with_$ac_useropt=no ;; + + --x) + # Obsolete; use --with-x. + with_x=yes ;; + + -x-includes | --x-includes | --x-include | --x-includ | --x-inclu \ + | --x-incl | --x-inc | --x-in | --x-i) + ac_prev=x_includes ;; + -x-includes=* | --x-includes=* | --x-include=* | --x-includ=* | --x-inclu=* \ + | --x-incl=* | --x-inc=* | --x-in=* | --x-i=*) + x_includes=$ac_optarg ;; + + -x-libraries | --x-libraries | --x-librarie | --x-librari \ + | --x-librar | --x-libra | --x-libr | --x-lib | --x-li | --x-l) + ac_prev=x_libraries ;; + -x-libraries=* | --x-libraries=* | --x-librarie=* | --x-librari=* \ + | --x-librar=* | --x-libra=* | --x-libr=* | --x-lib=* | --x-li=* | --x-l=*) + x_libraries=$ac_optarg ;; + + -*) as_fn_error $? "unrecognized option: \`$ac_option' +Try \`$0 --help' for more information" + ;; + + *=*) + ac_envvar=`expr "x$ac_option" : 'x\([^=]*\)='` + # Reject names that are not valid shell variable names. + case $ac_envvar in #( + '' | [0-9]* | *[!_$as_cr_alnum]* ) + as_fn_error $? "invalid variable name: \`$ac_envvar'" ;; + esac + eval $ac_envvar=\$ac_optarg + export $ac_envvar ;; + + *) + # FIXME: should be removed in autoconf 3.0. + printf "%s\n" "$as_me: WARNING: you should use --build, --host, --target" >&2 + expr "x$ac_option" : ".*[^-._$as_cr_alnum]" >/dev/null && + printf "%s\n" "$as_me: WARNING: invalid host type: $ac_option" >&2 + : "${build_alias=$ac_option} ${host_alias=$ac_option} ${target_alias=$ac_option}" + ;; + + esac +done + +if test -n "$ac_prev"; then + ac_option=--`echo $ac_prev | sed 's/_/-/g'` + as_fn_error $? "missing argument to $ac_option" +fi + +if test -n "$ac_unrecognized_opts"; then + case $enable_option_checking in + no) ;; + fatal) as_fn_error $? "unrecognized options: $ac_unrecognized_opts" ;; + *) printf "%s\n" "$as_me: WARNING: unrecognized options: $ac_unrecognized_opts" >&2 ;; + esac +fi + +# Check all directory arguments for consistency. +for ac_var in exec_prefix prefix bindir sbindir libexecdir datarootdir \ + datadir sysconfdir sharedstatedir localstatedir includedir \ + oldincludedir docdir infodir htmldir dvidir pdfdir psdir \ + libdir localedir mandir runstatedir +do + eval ac_val=\$$ac_var + # Remove trailing slashes. + case $ac_val in + */ ) + ac_val=`expr "X$ac_val" : 'X\(.*[^/]\)' \| "X$ac_val" : 'X\(.*\)'` + eval $ac_var=\$ac_val;; + esac + # Be sure to have absolute directory names. + case $ac_val in + [\\/$]* | ?:[\\/]* ) continue;; + NONE | '' ) case $ac_var in *prefix ) continue;; esac;; + esac + as_fn_error $? "expected an absolute directory name for --$ac_var: $ac_val" +done + +# There might be people who depend on the old broken behavior: `$host' +# used to hold the argument of --host etc. +# FIXME: To remove some day. +build=$build_alias +host=$host_alias +target=$target_alias + +# FIXME: To remove some day. +if test "x$host_alias" != x; then + if test "x$build_alias" = x; then + cross_compiling=maybe + elif test "x$build_alias" != "x$host_alias"; then + cross_compiling=yes + fi +fi + +ac_tool_prefix= +test -n "$host_alias" && ac_tool_prefix=$host_alias- + +test "$silent" = yes && exec 6>/dev/null + + +ac_pwd=`pwd` && test -n "$ac_pwd" && +ac_ls_di=`ls -di .` && +ac_pwd_ls_di=`cd "$ac_pwd" && ls -di .` || + as_fn_error $? "working directory cannot be determined" +test "X$ac_ls_di" = "X$ac_pwd_ls_di" || + as_fn_error $? "pwd does not report name of working directory" + + +# Find the source files, if location was not specified. +if test -z "$srcdir"; then + ac_srcdir_defaulted=yes + # Try the directory containing this script, then the parent directory. + ac_confdir=`$as_dirname -- "$as_myself" || +$as_expr X"$as_myself" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ + X"$as_myself" : 'X\(//\)[^/]' \| \ + X"$as_myself" : 'X\(//\)$' \| \ + X"$as_myself" : 'X\(/\)' \| . 2>/dev/null || +printf "%s\n" X"$as_myself" | + sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ + s//\1/ + q + } + /^X\(\/\/\)[^/].*/{ + s//\1/ + q + } + /^X\(\/\/\)$/{ + s//\1/ + q + } + /^X\(\/\).*/{ + s//\1/ + q + } + s/.*/./; q'` + srcdir=$ac_confdir + if test ! -r "$srcdir/$ac_unique_file"; then + srcdir=.. + fi +else + ac_srcdir_defaulted=no +fi +if test ! -r "$srcdir/$ac_unique_file"; then + test "$ac_srcdir_defaulted" = yes && srcdir="$ac_confdir or .." + as_fn_error $? "cannot find sources ($ac_unique_file) in $srcdir" +fi +ac_msg="sources are in $srcdir, but \`cd $srcdir' does not work" +ac_abs_confdir=`( + cd "$srcdir" && test -r "./$ac_unique_file" || as_fn_error $? "$ac_msg" + pwd)` +# When building in place, set srcdir=. +if test "$ac_abs_confdir" = "$ac_pwd"; then + srcdir=. +fi +# Remove unnecessary trailing slashes from srcdir. +# Double slashes in file names in object file debugging info +# mess up M-x gdb in Emacs. +case $srcdir in +*/) srcdir=`expr "X$srcdir" : 'X\(.*[^/]\)' \| "X$srcdir" : 'X\(.*\)'`;; +esac +for ac_var in $ac_precious_vars; do + eval ac_env_${ac_var}_set=\${${ac_var}+set} + eval ac_env_${ac_var}_value=\$${ac_var} + eval ac_cv_env_${ac_var}_set=\${${ac_var}+set} + eval ac_cv_env_${ac_var}_value=\$${ac_var} +done + +# +# Report the --help message. +# +if test "$ac_init_help" = "long"; then + # Omit some internal or obsolete options to make the list less imposing. + # This message is too long to be a string in the A/UX 3.1 sh. + cat <<_ACEOF +\`configure' configures ToxicR 1.0.1 to adapt to many kinds of systems. + +Usage: $0 [OPTION]... [VAR=VALUE]... + +To assign environment variables (e.g., CC, CFLAGS...), specify them as +VAR=VALUE. See below for descriptions of some of the useful variables. + +Defaults for the options are specified in brackets. + +Configuration: + -h, --help display this help and exit + --help=short display options specific to this package + --help=recursive display the short help of all the included packages + -V, --version display version information and exit + -q, --quiet, --silent do not print \`checking ...' messages + --cache-file=FILE cache test results in FILE [disabled] + -C, --config-cache alias for \`--cache-file=config.cache' + -n, --no-create do not create output files + --srcdir=DIR find the sources in DIR [configure dir or \`..'] + +Installation directories: + --prefix=PREFIX install architecture-independent files in PREFIX + [$ac_default_prefix] + --exec-prefix=EPREFIX install architecture-dependent files in EPREFIX + [PREFIX] + +By default, \`make install' will install all the files in +\`$ac_default_prefix/bin', \`$ac_default_prefix/lib' etc. You can specify +an installation prefix other than \`$ac_default_prefix' using \`--prefix', +for instance \`--prefix=\$HOME'. + +For better control, use the options below. + +Fine tuning of the installation directories: + --bindir=DIR user executables [EPREFIX/bin] + --sbindir=DIR system admin executables [EPREFIX/sbin] + --libexecdir=DIR program executables [EPREFIX/libexec] + --sysconfdir=DIR read-only single-machine data [PREFIX/etc] + --sharedstatedir=DIR modifiable architecture-independent data [PREFIX/com] + --localstatedir=DIR modifiable single-machine data [PREFIX/var] + --runstatedir=DIR modifiable per-process data [LOCALSTATEDIR/run] + --libdir=DIR object code libraries [EPREFIX/lib] + --includedir=DIR C header files [PREFIX/include] + --oldincludedir=DIR C header files for non-gcc [/usr/include] + --datarootdir=DIR read-only arch.-independent data root [PREFIX/share] + --datadir=DIR read-only architecture-independent data [DATAROOTDIR] + --infodir=DIR info documentation [DATAROOTDIR/info] + --localedir=DIR locale-dependent data [DATAROOTDIR/locale] + --mandir=DIR man documentation [DATAROOTDIR/man] + --docdir=DIR documentation root [DATAROOTDIR/doc/toxicr] + --htmldir=DIR html documentation [DOCDIR] + --dvidir=DIR dvi documentation [DOCDIR] + --pdfdir=DIR pdf documentation [DOCDIR] + --psdir=DIR ps documentation [DOCDIR] +_ACEOF + + cat <<\_ACEOF +_ACEOF +fi + +if test -n "$ac_init_help"; then + case $ac_init_help in + short | recursive ) echo "Configuration of ToxicR 1.0.1:";; + esac + cat <<\_ACEOF + +Some influential environment variables: + CC C compiler command + CFLAGS C compiler flags + LDFLAGS linker flags, e.g. -L if you have libraries in a + nonstandard directory + LIBS libraries to pass to the linker, e.g. -l + CPPFLAGS (Objective) C/C++ preprocessor flags, e.g. -I if + you have headers in a nonstandard directory + CPP C preprocessor + +Use these variables to override the choices made by `configure' or to help +it to find libraries and programs with nonstandard names/locations. + +Report bugs to the package provider. +_ACEOF +ac_status=$? +fi + +if test "$ac_init_help" = "recursive"; then + # If there are subdirs, report their specific --help. + for ac_dir in : $ac_subdirs_all; do test "x$ac_dir" = x: && continue + test -d "$ac_dir" || + { cd "$srcdir" && ac_pwd=`pwd` && srcdir=. && test -d "$ac_dir"; } || + continue + ac_builddir=. + +case "$ac_dir" in +.) ac_dir_suffix= ac_top_builddir_sub=. ac_top_build_prefix= ;; +*) + ac_dir_suffix=/`printf "%s\n" "$ac_dir" | sed 's|^\.[\\/]||'` + # A ".." for each directory in $ac_dir_suffix. + ac_top_builddir_sub=`printf "%s\n" "$ac_dir_suffix" | sed 's|/[^\\/]*|/..|g;s|/||'` + case $ac_top_builddir_sub in + "") ac_top_builddir_sub=. ac_top_build_prefix= ;; + *) ac_top_build_prefix=$ac_top_builddir_sub/ ;; + esac ;; +esac +ac_abs_top_builddir=$ac_pwd +ac_abs_builddir=$ac_pwd$ac_dir_suffix +# for backward compatibility: +ac_top_builddir=$ac_top_build_prefix + +case $srcdir in + .) # We are building in place. + ac_srcdir=. + ac_top_srcdir=$ac_top_builddir_sub + ac_abs_top_srcdir=$ac_pwd ;; + [\\/]* | ?:[\\/]* ) # Absolute name. + ac_srcdir=$srcdir$ac_dir_suffix; + ac_top_srcdir=$srcdir + ac_abs_top_srcdir=$srcdir ;; + *) # Relative name. + ac_srcdir=$ac_top_build_prefix$srcdir$ac_dir_suffix + ac_top_srcdir=$ac_top_build_prefix$srcdir + ac_abs_top_srcdir=$ac_pwd/$srcdir ;; +esac +ac_abs_srcdir=$ac_abs_top_srcdir$ac_dir_suffix + + cd "$ac_dir" || { ac_status=$?; continue; } + # Check for configure.gnu first; this name is used for a wrapper for + # Metaconfig's "Configure" on case-insensitive file systems. + if test -f "$ac_srcdir/configure.gnu"; then + echo && + $SHELL "$ac_srcdir/configure.gnu" --help=recursive + elif test -f "$ac_srcdir/configure"; then + echo && + $SHELL "$ac_srcdir/configure" --help=recursive + else + printf "%s\n" "$as_me: WARNING: no configuration information is in $ac_dir" >&2 + fi || ac_status=$? + cd "$ac_pwd" || { ac_status=$?; break; } + done +fi + +test -n "$ac_init_help" && exit $ac_status +if $ac_init_version; then + cat <<\_ACEOF +ToxicR configure 1.0.1 +generated by GNU Autoconf 2.71 + +Copyright (C) 2021 Free Software Foundation, Inc. +This configure script is free software; the Free Software Foundation +gives unlimited permission to copy, distribute and modify it. +_ACEOF + exit +fi + +## ------------------------ ## +## Autoconf initialization. ## +## ------------------------ ## + +# ac_fn_c_try_compile LINENO +# -------------------------- +# Try to compile conftest.$ac_ext, and return whether this succeeded. +ac_fn_c_try_compile () +{ + as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + rm -f conftest.$ac_objext conftest.beam + if { { ac_try="$ac_compile" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +printf "%s\n" "$ac_try_echo"; } >&5 + (eval "$ac_compile") 2>conftest.err + ac_status=$? + if test -s conftest.err; then + grep -v '^ *+' conftest.err >conftest.er1 + cat conftest.er1 >&5 + mv -f conftest.er1 conftest.err + fi + printf "%s\n" "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } && { + test -z "$ac_c_werror_flag" || + test ! -s conftest.err + } && test -s conftest.$ac_objext +then : + ac_retval=0 +else $as_nop + printf "%s\n" "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + ac_retval=1 +fi + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno + as_fn_set_status $ac_retval + +} # ac_fn_c_try_compile + +# ac_fn_c_try_cpp LINENO +# ---------------------- +# Try to preprocess conftest.$ac_ext, and return whether this succeeded. +ac_fn_c_try_cpp () +{ + as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + if { { ac_try="$ac_cpp conftest.$ac_ext" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +printf "%s\n" "$ac_try_echo"; } >&5 + (eval "$ac_cpp conftest.$ac_ext") 2>conftest.err + ac_status=$? + if test -s conftest.err; then + grep -v '^ *+' conftest.err >conftest.er1 + cat conftest.er1 >&5 + mv -f conftest.er1 conftest.err + fi + printf "%s\n" "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } > conftest.i && { + test -z "$ac_c_preproc_warn_flag$ac_c_werror_flag" || + test ! -s conftest.err + } +then : + ac_retval=0 +else $as_nop + printf "%s\n" "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + ac_retval=1 +fi + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno + as_fn_set_status $ac_retval + +} # ac_fn_c_try_cpp +ac_configure_args_raw= +for ac_arg +do + case $ac_arg in + *\'*) + ac_arg=`printf "%s\n" "$ac_arg" | sed "s/'/'\\\\\\\\''/g"` ;; + esac + as_fn_append ac_configure_args_raw " '$ac_arg'" +done + +case $ac_configure_args_raw in + *$as_nl*) + ac_safe_unquote= ;; + *) + ac_unsafe_z='|&;<>()$`\\"*?[ '' ' # This string ends in space, tab. + ac_unsafe_a="$ac_unsafe_z#~" + ac_safe_unquote="s/ '\\([^$ac_unsafe_a][^$ac_unsafe_z]*\\)'/ \\1/g" + ac_configure_args_raw=` printf "%s\n" "$ac_configure_args_raw" | sed "$ac_safe_unquote"`;; +esac + +cat >config.log <<_ACEOF +This file contains any messages produced by compilers while +running configure, to aid debugging if configure makes a mistake. + +It was created by ToxicR $as_me 1.0.1, which was +generated by GNU Autoconf 2.71. Invocation command line was + + $ $0$ac_configure_args_raw + +_ACEOF +exec 5>>config.log +{ +cat <<_ASUNAME +## --------- ## +## Platform. ## +## --------- ## + +hostname = `(hostname || uname -n) 2>/dev/null | sed 1q` +uname -m = `(uname -m) 2>/dev/null || echo unknown` +uname -r = `(uname -r) 2>/dev/null || echo unknown` +uname -s = `(uname -s) 2>/dev/null || echo unknown` +uname -v = `(uname -v) 2>/dev/null || echo unknown` + +/usr/bin/uname -p = `(/usr/bin/uname -p) 2>/dev/null || echo unknown` +/bin/uname -X = `(/bin/uname -X) 2>/dev/null || echo unknown` + +/bin/arch = `(/bin/arch) 2>/dev/null || echo unknown` +/usr/bin/arch -k = `(/usr/bin/arch -k) 2>/dev/null || echo unknown` +/usr/convex/getsysinfo = `(/usr/convex/getsysinfo) 2>/dev/null || echo unknown` +/usr/bin/hostinfo = `(/usr/bin/hostinfo) 2>/dev/null || echo unknown` +/bin/machine = `(/bin/machine) 2>/dev/null || echo unknown` +/usr/bin/oslevel = `(/usr/bin/oslevel) 2>/dev/null || echo unknown` +/bin/universe = `(/bin/universe) 2>/dev/null || echo unknown` + +_ASUNAME + +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + case $as_dir in #((( + '') as_dir=./ ;; + */) ;; + *) as_dir=$as_dir/ ;; + esac + printf "%s\n" "PATH: $as_dir" + done +IFS=$as_save_IFS + +} >&5 + +cat >&5 <<_ACEOF + + +## ----------- ## +## Core tests. ## +## ----------- ## + +_ACEOF + + +# Keep a trace of the command line. +# Strip out --no-create and --no-recursion so they do not pile up. +# Strip out --silent because we don't want to record it for future runs. +# Also quote any args containing shell meta-characters. +# Make two passes to allow for proper duplicate-argument suppression. +ac_configure_args= +ac_configure_args0= +ac_configure_args1= +ac_must_keep_next=false +for ac_pass in 1 2 +do + for ac_arg + do + case $ac_arg in + -no-create | --no-c* | -n | -no-recursion | --no-r*) continue ;; + -q | -quiet | --quiet | --quie | --qui | --qu | --q \ + | -silent | --silent | --silen | --sile | --sil) + continue ;; + *\'*) + ac_arg=`printf "%s\n" "$ac_arg" | sed "s/'/'\\\\\\\\''/g"` ;; + esac + case $ac_pass in + 1) as_fn_append ac_configure_args0 " '$ac_arg'" ;; + 2) + as_fn_append ac_configure_args1 " '$ac_arg'" + if test $ac_must_keep_next = true; then + ac_must_keep_next=false # Got value, back to normal. + else + case $ac_arg in + *=* | --config-cache | -C | -disable-* | --disable-* \ + | -enable-* | --enable-* | -gas | --g* | -nfp | --nf* \ + | -q | -quiet | --q* | -silent | --sil* | -v | -verb* \ + | -with-* | --with-* | -without-* | --without-* | --x) + case "$ac_configure_args0 " in + "$ac_configure_args1"*" '$ac_arg' "* ) continue ;; + esac + ;; + -* ) ac_must_keep_next=true ;; + esac + fi + as_fn_append ac_configure_args " '$ac_arg'" + ;; + esac + done +done +{ ac_configure_args0=; unset ac_configure_args0;} +{ ac_configure_args1=; unset ac_configure_args1;} + +# When interrupted or exit'd, cleanup temporary files, and complete +# config.log. We remove comments because anyway the quotes in there +# would cause problems or look ugly. +# WARNING: Use '\'' to represent an apostrophe within the trap. +# WARNING: Do not start the trap code with a newline, due to a FreeBSD 4.0 bug. +trap 'exit_status=$? + # Sanitize IFS. + IFS=" "" $as_nl" + # Save into config.log some information that might help in debugging. + { + echo + + printf "%s\n" "## ---------------- ## +## Cache variables. ## +## ---------------- ##" + echo + # The following way of writing the cache mishandles newlines in values, +( + for ac_var in `(set) 2>&1 | sed -n '\''s/^\([a-zA-Z_][a-zA-Z0-9_]*\)=.*/\1/p'\''`; do + eval ac_val=\$$ac_var + case $ac_val in #( + *${as_nl}*) + case $ac_var in #( + *_cv_*) { printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: cache variable $ac_var contains a newline" >&5 +printf "%s\n" "$as_me: WARNING: cache variable $ac_var contains a newline" >&2;} ;; + esac + case $ac_var in #( + _ | IFS | as_nl) ;; #( + BASH_ARGV | BASH_SOURCE) eval $ac_var= ;; #( + *) { eval $ac_var=; unset $ac_var;} ;; + esac ;; + esac + done + (set) 2>&1 | + case $as_nl`(ac_space='\'' '\''; set) 2>&1` in #( + *${as_nl}ac_space=\ *) + sed -n \ + "s/'\''/'\''\\\\'\'''\''/g; + s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\''\\2'\''/p" + ;; #( + *) + sed -n "/^[_$as_cr_alnum]*_cv_[_$as_cr_alnum]*=/p" + ;; + esac | + sort +) + echo + + printf "%s\n" "## ----------------- ## +## Output variables. ## +## ----------------- ##" + echo + for ac_var in $ac_subst_vars + do + eval ac_val=\$$ac_var + case $ac_val in + *\'\''*) ac_val=`printf "%s\n" "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;; + esac + printf "%s\n" "$ac_var='\''$ac_val'\''" + done | sort + echo + + if test -n "$ac_subst_files"; then + printf "%s\n" "## ------------------- ## +## File substitutions. ## +## ------------------- ##" + echo + for ac_var in $ac_subst_files + do + eval ac_val=\$$ac_var + case $ac_val in + *\'\''*) ac_val=`printf "%s\n" "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;; + esac + printf "%s\n" "$ac_var='\''$ac_val'\''" + done | sort + echo + fi + + if test -s confdefs.h; then + printf "%s\n" "## ----------- ## +## confdefs.h. ## +## ----------- ##" + echo + cat confdefs.h + echo + fi + test "$ac_signal" != 0 && + printf "%s\n" "$as_me: caught signal $ac_signal" + printf "%s\n" "$as_me: exit $exit_status" + } >&5 + rm -f core *.core core.conftest.* && + rm -f -r conftest* confdefs* conf$$* $ac_clean_files && + exit $exit_status +' 0 +for ac_signal in 1 2 13 15; do + trap 'ac_signal='$ac_signal'; as_fn_exit 1' $ac_signal +done +ac_signal=0 + +# confdefs.h avoids OS command line length limits that DEFS can exceed. +rm -f -r conftest* confdefs.h + +printf "%s\n" "/* confdefs.h */" > confdefs.h + +# Predefined preprocessor variables. + +printf "%s\n" "#define PACKAGE_NAME \"$PACKAGE_NAME\"" >>confdefs.h + +printf "%s\n" "#define PACKAGE_TARNAME \"$PACKAGE_TARNAME\"" >>confdefs.h + +printf "%s\n" "#define PACKAGE_VERSION \"$PACKAGE_VERSION\"" >>confdefs.h + +printf "%s\n" "#define PACKAGE_STRING \"$PACKAGE_STRING\"" >>confdefs.h + +printf "%s\n" "#define PACKAGE_BUGREPORT \"$PACKAGE_BUGREPORT\"" >>confdefs.h + +printf "%s\n" "#define PACKAGE_URL \"$PACKAGE_URL\"" >>confdefs.h + + +# Let the site file select an alternate cache file if it wants to. +# Prefer an explicitly selected file to automatically selected ones. +if test -n "$CONFIG_SITE"; then + ac_site_files="$CONFIG_SITE" +elif test "x$prefix" != xNONE; then + ac_site_files="$prefix/share/config.site $prefix/etc/config.site" +else + ac_site_files="$ac_default_prefix/share/config.site $ac_default_prefix/etc/config.site" +fi + +for ac_site_file in $ac_site_files +do + case $ac_site_file in #( + */*) : + ;; #( + *) : + ac_site_file=./$ac_site_file ;; +esac + if test -f "$ac_site_file" && test -r "$ac_site_file"; then + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: loading site script $ac_site_file" >&5 +printf "%s\n" "$as_me: loading site script $ac_site_file" >&6;} + sed 's/^/| /' "$ac_site_file" >&5 + . "$ac_site_file" \ + || { { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +printf "%s\n" "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error $? "failed to load site script $ac_site_file +See \`config.log' for more details" "$LINENO" 5; } + fi +done + +if test -r "$cache_file"; then + # Some versions of bash will fail to source /dev/null (special files + # actually), so we avoid doing that. DJGPP emulates it as a regular file. + if test /dev/null != "$cache_file" && test -f "$cache_file"; then + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: loading cache $cache_file" >&5 +printf "%s\n" "$as_me: loading cache $cache_file" >&6;} + case $cache_file in + [\\/]* | ?:[\\/]* ) . "$cache_file";; + *) . "./$cache_file";; + esac + fi +else + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: creating cache $cache_file" >&5 +printf "%s\n" "$as_me: creating cache $cache_file" >&6;} + >$cache_file +fi + +# Test code for whether the C compiler supports C89 (global declarations) +ac_c_conftest_c89_globals=' +/* Does the compiler advertise C89 conformance? + Do not test the value of __STDC__, because some compilers set it to 0 + while being otherwise adequately conformant. */ +#if !defined __STDC__ +# error "Compiler does not advertise C89 conformance" +#endif + +#include +#include +struct stat; +/* Most of the following tests are stolen from RCS 5.7 src/conf.sh. */ +struct buf { int x; }; +struct buf * (*rcsopen) (struct buf *, struct stat *, int); +static char *e (p, i) + char **p; + int i; +{ + return p[i]; +} +static char *f (char * (*g) (char **, int), char **p, ...) +{ + char *s; + va_list v; + va_start (v,p); + s = g (p, va_arg (v,int)); + va_end (v); + return s; +} + +/* OSF 4.0 Compaq cc is some sort of almost-ANSI by default. It has + function prototypes and stuff, but not \xHH hex character constants. + These do not provoke an error unfortunately, instead are silently treated + as an "x". The following induces an error, until -std is added to get + proper ANSI mode. Curiously \x00 != x always comes out true, for an + array size at least. It is necessary to write \x00 == 0 to get something + that is true only with -std. */ +int osf4_cc_array ['\''\x00'\'' == 0 ? 1 : -1]; + +/* IBM C 6 for AIX is almost-ANSI by default, but it replaces macro parameters + inside strings and character constants. */ +#define FOO(x) '\''x'\'' +int xlc6_cc_array[FOO(a) == '\''x'\'' ? 1 : -1]; + +int test (int i, double x); +struct s1 {int (*f) (int a);}; +struct s2 {int (*f) (double a);}; +int pairnames (int, char **, int *(*)(struct buf *, struct stat *, int), + int, int);' + +# Test code for whether the C compiler supports C89 (body of main). +ac_c_conftest_c89_main=' +ok |= (argc == 0 || f (e, argv, 0) != argv[0] || f (e, argv, 1) != argv[1]); +' + +# Test code for whether the C compiler supports C99 (global declarations) +ac_c_conftest_c99_globals=' +// Does the compiler advertise C99 conformance? +#if !defined __STDC_VERSION__ || __STDC_VERSION__ < 199901L +# error "Compiler does not advertise C99 conformance" +#endif + +#include +extern int puts (const char *); +extern int printf (const char *, ...); +extern int dprintf (int, const char *, ...); +extern void *malloc (size_t); + +// Check varargs macros. These examples are taken from C99 6.10.3.5. +// dprintf is used instead of fprintf to avoid needing to declare +// FILE and stderr. +#define debug(...) dprintf (2, __VA_ARGS__) +#define showlist(...) puts (#__VA_ARGS__) +#define report(test,...) ((test) ? puts (#test) : printf (__VA_ARGS__)) +static void +test_varargs_macros (void) +{ + int x = 1234; + int y = 5678; + debug ("Flag"); + debug ("X = %d\n", x); + showlist (The first, second, and third items.); + report (x>y, "x is %d but y is %d", x, y); +} + +// Check long long types. +#define BIG64 18446744073709551615ull +#define BIG32 4294967295ul +#define BIG_OK (BIG64 / BIG32 == 4294967297ull && BIG64 % BIG32 == 0) +#if !BIG_OK + #error "your preprocessor is broken" +#endif +#if BIG_OK +#else + #error "your preprocessor is broken" +#endif +static long long int bignum = -9223372036854775807LL; +static unsigned long long int ubignum = BIG64; + +struct incomplete_array +{ + int datasize; + double data[]; +}; + +struct named_init { + int number; + const wchar_t *name; + double average; +}; + +typedef const char *ccp; + +static inline int +test_restrict (ccp restrict text) +{ + // See if C++-style comments work. + // Iterate through items via the restricted pointer. + // Also check for declarations in for loops. + for (unsigned int i = 0; *(text+i) != '\''\0'\''; ++i) + continue; + return 0; +} + +// Check varargs and va_copy. +static bool +test_varargs (const char *format, ...) +{ + va_list args; + va_start (args, format); + va_list args_copy; + va_copy (args_copy, args); + + const char *str = ""; + int number = 0; + float fnumber = 0; + + while (*format) + { + switch (*format++) + { + case '\''s'\'': // string + str = va_arg (args_copy, const char *); + break; + case '\''d'\'': // int + number = va_arg (args_copy, int); + break; + case '\''f'\'': // float + fnumber = va_arg (args_copy, double); + break; + default: + break; + } + } + va_end (args_copy); + va_end (args); + + return *str && number && fnumber; +} +' + +# Test code for whether the C compiler supports C99 (body of main). +ac_c_conftest_c99_main=' + // Check bool. + _Bool success = false; + success |= (argc != 0); + + // Check restrict. + if (test_restrict ("String literal") == 0) + success = true; + char *restrict newvar = "Another string"; + + // Check varargs. + success &= test_varargs ("s, d'\'' f .", "string", 65, 34.234); + test_varargs_macros (); + + // Check flexible array members. + struct incomplete_array *ia = + malloc (sizeof (struct incomplete_array) + (sizeof (double) * 10)); + ia->datasize = 10; + for (int i = 0; i < ia->datasize; ++i) + ia->data[i] = i * 1.234; + + // Check named initializers. + struct named_init ni = { + .number = 34, + .name = L"Test wide string", + .average = 543.34343, + }; + + ni.number = 58; + + int dynamic_array[ni.number]; + dynamic_array[0] = argv[0][0]; + dynamic_array[ni.number - 1] = 543; + + // work around unused variable warnings + ok |= (!success || bignum == 0LL || ubignum == 0uLL || newvar[0] == '\''x'\'' + || dynamic_array[ni.number - 1] != 543); +' + +# Test code for whether the C compiler supports C11 (global declarations) +ac_c_conftest_c11_globals=' +// Does the compiler advertise C11 conformance? +#if !defined __STDC_VERSION__ || __STDC_VERSION__ < 201112L +# error "Compiler does not advertise C11 conformance" +#endif + +// Check _Alignas. +char _Alignas (double) aligned_as_double; +char _Alignas (0) no_special_alignment; +extern char aligned_as_int; +char _Alignas (0) _Alignas (int) aligned_as_int; + +// Check _Alignof. +enum +{ + int_alignment = _Alignof (int), + int_array_alignment = _Alignof (int[100]), + char_alignment = _Alignof (char) +}; +_Static_assert (0 < -_Alignof (int), "_Alignof is signed"); + +// Check _Noreturn. +int _Noreturn does_not_return (void) { for (;;) continue; } + +// Check _Static_assert. +struct test_static_assert +{ + int x; + _Static_assert (sizeof (int) <= sizeof (long int), + "_Static_assert does not work in struct"); + long int y; +}; + +// Check UTF-8 literals. +#define u8 syntax error! +char const utf8_literal[] = u8"happens to be ASCII" "another string"; + +// Check duplicate typedefs. +typedef long *long_ptr; +typedef long int *long_ptr; +typedef long_ptr long_ptr; + +// Anonymous structures and unions -- taken from C11 6.7.2.1 Example 1. +struct anonymous +{ + union { + struct { int i; int j; }; + struct { int k; long int l; } w; + }; + int m; +} v1; +' + +# Test code for whether the C compiler supports C11 (body of main). +ac_c_conftest_c11_main=' + _Static_assert ((offsetof (struct anonymous, i) + == offsetof (struct anonymous, w.k)), + "Anonymous union alignment botch"); + v1.i = 2; + v1.w.k = 5; + ok |= v1.i != 5; +' + +# Test code for whether the C compiler supports C11 (complete). +ac_c_conftest_c11_program="${ac_c_conftest_c89_globals} +${ac_c_conftest_c99_globals} +${ac_c_conftest_c11_globals} + +int +main (int argc, char **argv) +{ + int ok = 0; + ${ac_c_conftest_c89_main} + ${ac_c_conftest_c99_main} + ${ac_c_conftest_c11_main} + return ok; +} +" + +# Test code for whether the C compiler supports C99 (complete). +ac_c_conftest_c99_program="${ac_c_conftest_c89_globals} +${ac_c_conftest_c99_globals} + +int +main (int argc, char **argv) +{ + int ok = 0; + ${ac_c_conftest_c89_main} + ${ac_c_conftest_c99_main} + return ok; +} +" + +# Test code for whether the C compiler supports C89 (complete). +ac_c_conftest_c89_program="${ac_c_conftest_c89_globals} + +int +main (int argc, char **argv) +{ + int ok = 0; + ${ac_c_conftest_c89_main} + return ok; +} +" + +# Check that the precious variables saved in the cache have kept the same +# value. +ac_cache_corrupted=false +for ac_var in $ac_precious_vars; do + eval ac_old_set=\$ac_cv_env_${ac_var}_set + eval ac_new_set=\$ac_env_${ac_var}_set + eval ac_old_val=\$ac_cv_env_${ac_var}_value + eval ac_new_val=\$ac_env_${ac_var}_value + case $ac_old_set,$ac_new_set in + set,) + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&5 +printf "%s\n" "$as_me: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&2;} + ac_cache_corrupted=: ;; + ,set) + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' was not set in the previous run" >&5 +printf "%s\n" "$as_me: error: \`$ac_var' was not set in the previous run" >&2;} + ac_cache_corrupted=: ;; + ,);; + *) + if test "x$ac_old_val" != "x$ac_new_val"; then + # differences in whitespace do not lead to failure. + ac_old_val_w=`echo x $ac_old_val` + ac_new_val_w=`echo x $ac_new_val` + if test "$ac_old_val_w" != "$ac_new_val_w"; then + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' has changed since the previous run:" >&5 +printf "%s\n" "$as_me: error: \`$ac_var' has changed since the previous run:" >&2;} + ac_cache_corrupted=: + else + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: warning: ignoring whitespace changes in \`$ac_var' since the previous run:" >&5 +printf "%s\n" "$as_me: warning: ignoring whitespace changes in \`$ac_var' since the previous run:" >&2;} + eval $ac_var=\$ac_old_val + fi + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: former value: \`$ac_old_val'" >&5 +printf "%s\n" "$as_me: former value: \`$ac_old_val'" >&2;} + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: current value: \`$ac_new_val'" >&5 +printf "%s\n" "$as_me: current value: \`$ac_new_val'" >&2;} + fi;; + esac + # Pass precious variables to config.status. + if test "$ac_new_set" = set; then + case $ac_new_val in + *\'*) ac_arg=$ac_var=`printf "%s\n" "$ac_new_val" | sed "s/'/'\\\\\\\\''/g"` ;; + *) ac_arg=$ac_var=$ac_new_val ;; + esac + case " $ac_configure_args " in + *" '$ac_arg' "*) ;; # Avoid dups. Use of quotes ensures accuracy. + *) as_fn_append ac_configure_args " '$ac_arg'" ;; + esac + fi +done +if $ac_cache_corrupted; then + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +printf "%s\n" "$as_me: error: in \`$ac_pwd':" >&2;} + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: changes in the environment can compromise the build" >&5 +printf "%s\n" "$as_me: error: changes in the environment can compromise the build" >&2;} + as_fn_error $? "run \`${MAKE-make} distclean' and/or \`rm $cache_file' + and start over" "$LINENO" 5 +fi +## -------------------- ## +## Main body of script. ## +## -------------------- ## + +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + + +CXX=`"${R_HOME}/bin/R" CMD config CXX` +CXXFLAGS=`"${R_HOME}/bin/R" CMD config CXXFLAGS` +CPPFLAGS=`"${R_HOME}/bin/R" CMD config CPPFLAGS` +ac_ext=cpp +ac_cpp='$CXXCPP $CPPFLAGS' +ac_compile='$CXX -c $CXXFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CXX -o conftest$ac_exeext $CXXFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_cxx_compiler_gnu + + + + + + + + + + +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu +if test -n "$ac_tool_prefix"; then + # Extract the first word of "${ac_tool_prefix}gcc", so it can be a program name with args. +set dummy ${ac_tool_prefix}gcc; ac_word=$2 +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +printf %s "checking for $ac_word... " >&6; } +if test ${ac_cv_prog_CC+y} +then : + printf %s "(cached) " >&6 +else $as_nop + if test -n "$CC"; then + ac_cv_prog_CC="$CC" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + case $as_dir in #((( + '') as_dir=./ ;; + */) ;; + *) as_dir=$as_dir/ ;; + esac + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir$ac_word$ac_exec_ext"; then + ac_cv_prog_CC="${ac_tool_prefix}gcc" + printf "%s\n" "$as_me:${as_lineno-$LINENO}: found $as_dir$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +CC=$ac_cv_prog_CC +if test -n "$CC"; then + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $CC" >&5 +printf "%s\n" "$CC" >&6; } +else + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 +printf "%s\n" "no" >&6; } +fi + + +fi +if test -z "$ac_cv_prog_CC"; then + ac_ct_CC=$CC + # Extract the first word of "gcc", so it can be a program name with args. +set dummy gcc; ac_word=$2 +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +printf %s "checking for $ac_word... " >&6; } +if test ${ac_cv_prog_ac_ct_CC+y} +then : + printf %s "(cached) " >&6 +else $as_nop + if test -n "$ac_ct_CC"; then + ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + case $as_dir in #((( + '') as_dir=./ ;; + */) ;; + *) as_dir=$as_dir/ ;; + esac + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir$ac_word$ac_exec_ext"; then + ac_cv_prog_ac_ct_CC="gcc" + printf "%s\n" "$as_me:${as_lineno-$LINENO}: found $as_dir$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +ac_ct_CC=$ac_cv_prog_ac_ct_CC +if test -n "$ac_ct_CC"; then + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_ct_CC" >&5 +printf "%s\n" "$ac_ct_CC" >&6; } +else + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 +printf "%s\n" "no" >&6; } +fi + + if test "x$ac_ct_CC" = x; then + CC="" + else + case $cross_compiling:$ac_tool_warned in +yes:) +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 +printf "%s\n" "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} +ac_tool_warned=yes ;; +esac + CC=$ac_ct_CC + fi +else + CC="$ac_cv_prog_CC" +fi + +if test -z "$CC"; then + if test -n "$ac_tool_prefix"; then + # Extract the first word of "${ac_tool_prefix}cc", so it can be a program name with args. +set dummy ${ac_tool_prefix}cc; ac_word=$2 +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +printf %s "checking for $ac_word... " >&6; } +if test ${ac_cv_prog_CC+y} +then : + printf %s "(cached) " >&6 +else $as_nop + if test -n "$CC"; then + ac_cv_prog_CC="$CC" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + case $as_dir in #((( + '') as_dir=./ ;; + */) ;; + *) as_dir=$as_dir/ ;; + esac + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir$ac_word$ac_exec_ext"; then + ac_cv_prog_CC="${ac_tool_prefix}cc" + printf "%s\n" "$as_me:${as_lineno-$LINENO}: found $as_dir$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +CC=$ac_cv_prog_CC +if test -n "$CC"; then + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $CC" >&5 +printf "%s\n" "$CC" >&6; } +else + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 +printf "%s\n" "no" >&6; } +fi + + + fi +fi +if test -z "$CC"; then + # Extract the first word of "cc", so it can be a program name with args. +set dummy cc; ac_word=$2 +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +printf %s "checking for $ac_word... " >&6; } +if test ${ac_cv_prog_CC+y} +then : + printf %s "(cached) " >&6 +else $as_nop + if test -n "$CC"; then + ac_cv_prog_CC="$CC" # Let the user override the test. +else + ac_prog_rejected=no +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + case $as_dir in #((( + '') as_dir=./ ;; + */) ;; + *) as_dir=$as_dir/ ;; + esac + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir$ac_word$ac_exec_ext"; then + if test "$as_dir$ac_word$ac_exec_ext" = "/usr/ucb/cc"; then + ac_prog_rejected=yes + continue + fi + ac_cv_prog_CC="cc" + printf "%s\n" "$as_me:${as_lineno-$LINENO}: found $as_dir$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +if test $ac_prog_rejected = yes; then + # We found a bogon in the path, so make sure we never use it. + set dummy $ac_cv_prog_CC + shift + if test $# != 0; then + # We chose a different compiler from the bogus one. + # However, it has the same basename, so the bogon will be chosen + # first if we set CC to just the basename; use the full file name. + shift + ac_cv_prog_CC="$as_dir$ac_word${1+' '}$@" + fi +fi +fi +fi +CC=$ac_cv_prog_CC +if test -n "$CC"; then + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $CC" >&5 +printf "%s\n" "$CC" >&6; } +else + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 +printf "%s\n" "no" >&6; } +fi + + +fi +if test -z "$CC"; then + if test -n "$ac_tool_prefix"; then + for ac_prog in cl.exe + do + # Extract the first word of "$ac_tool_prefix$ac_prog", so it can be a program name with args. +set dummy $ac_tool_prefix$ac_prog; ac_word=$2 +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +printf %s "checking for $ac_word... " >&6; } +if test ${ac_cv_prog_CC+y} +then : + printf %s "(cached) " >&6 +else $as_nop + if test -n "$CC"; then + ac_cv_prog_CC="$CC" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + case $as_dir in #((( + '') as_dir=./ ;; + */) ;; + *) as_dir=$as_dir/ ;; + esac + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir$ac_word$ac_exec_ext"; then + ac_cv_prog_CC="$ac_tool_prefix$ac_prog" + printf "%s\n" "$as_me:${as_lineno-$LINENO}: found $as_dir$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +CC=$ac_cv_prog_CC +if test -n "$CC"; then + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $CC" >&5 +printf "%s\n" "$CC" >&6; } +else + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 +printf "%s\n" "no" >&6; } +fi + + + test -n "$CC" && break + done +fi +if test -z "$CC"; then + ac_ct_CC=$CC + for ac_prog in cl.exe +do + # Extract the first word of "$ac_prog", so it can be a program name with args. +set dummy $ac_prog; ac_word=$2 +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +printf %s "checking for $ac_word... " >&6; } +if test ${ac_cv_prog_ac_ct_CC+y} +then : + printf %s "(cached) " >&6 +else $as_nop + if test -n "$ac_ct_CC"; then + ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + case $as_dir in #((( + '') as_dir=./ ;; + */) ;; + *) as_dir=$as_dir/ ;; + esac + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir$ac_word$ac_exec_ext"; then + ac_cv_prog_ac_ct_CC="$ac_prog" + printf "%s\n" "$as_me:${as_lineno-$LINENO}: found $as_dir$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +ac_ct_CC=$ac_cv_prog_ac_ct_CC +if test -n "$ac_ct_CC"; then + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_ct_CC" >&5 +printf "%s\n" "$ac_ct_CC" >&6; } +else + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 +printf "%s\n" "no" >&6; } +fi + + + test -n "$ac_ct_CC" && break +done + + if test "x$ac_ct_CC" = x; then + CC="" + else + case $cross_compiling:$ac_tool_warned in +yes:) +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 +printf "%s\n" "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} +ac_tool_warned=yes ;; +esac + CC=$ac_ct_CC + fi +fi + +fi +if test -z "$CC"; then + if test -n "$ac_tool_prefix"; then + # Extract the first word of "${ac_tool_prefix}clang", so it can be a program name with args. +set dummy ${ac_tool_prefix}clang; ac_word=$2 +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +printf %s "checking for $ac_word... " >&6; } +if test ${ac_cv_prog_CC+y} +then : + printf %s "(cached) " >&6 +else $as_nop + if test -n "$CC"; then + ac_cv_prog_CC="$CC" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + case $as_dir in #((( + '') as_dir=./ ;; + */) ;; + *) as_dir=$as_dir/ ;; + esac + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir$ac_word$ac_exec_ext"; then + ac_cv_prog_CC="${ac_tool_prefix}clang" + printf "%s\n" "$as_me:${as_lineno-$LINENO}: found $as_dir$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +CC=$ac_cv_prog_CC +if test -n "$CC"; then + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $CC" >&5 +printf "%s\n" "$CC" >&6; } +else + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 +printf "%s\n" "no" >&6; } +fi + + +fi +if test -z "$ac_cv_prog_CC"; then + ac_ct_CC=$CC + # Extract the first word of "clang", so it can be a program name with args. +set dummy clang; ac_word=$2 +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +printf %s "checking for $ac_word... " >&6; } +if test ${ac_cv_prog_ac_ct_CC+y} +then : + printf %s "(cached) " >&6 +else $as_nop + if test -n "$ac_ct_CC"; then + ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + case $as_dir in #((( + '') as_dir=./ ;; + */) ;; + *) as_dir=$as_dir/ ;; + esac + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir$ac_word$ac_exec_ext"; then + ac_cv_prog_ac_ct_CC="clang" + printf "%s\n" "$as_me:${as_lineno-$LINENO}: found $as_dir$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +ac_ct_CC=$ac_cv_prog_ac_ct_CC +if test -n "$ac_ct_CC"; then + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_ct_CC" >&5 +printf "%s\n" "$ac_ct_CC" >&6; } +else + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 +printf "%s\n" "no" >&6; } +fi + + if test "x$ac_ct_CC" = x; then + CC="" + else + case $cross_compiling:$ac_tool_warned in +yes:) +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 +printf "%s\n" "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} +ac_tool_warned=yes ;; +esac + CC=$ac_ct_CC + fi +else + CC="$ac_cv_prog_CC" +fi + +fi + + +test -z "$CC" && { { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +printf "%s\n" "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error $? "no acceptable C compiler found in \$PATH +See \`config.log' for more details" "$LINENO" 5; } + +# Provide some information about the compiler. +printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for C compiler version" >&5 +set X $ac_compile +ac_compiler=$2 +for ac_option in --version -v -V -qversion -version; do + { { ac_try="$ac_compiler $ac_option >&5" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +printf "%s\n" "$ac_try_echo"; } >&5 + (eval "$ac_compiler $ac_option >&5") 2>conftest.err + ac_status=$? + if test -s conftest.err; then + sed '10a\ +... rest of stderr output deleted ... + 10q' conftest.err >conftest.er1 + cat conftest.er1 >&5 + fi + rm -f conftest.er1 conftest.err + printf "%s\n" "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } +done + +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main (void) +{ + + ; + return 0; +} +_ACEOF +ac_clean_files_save=$ac_clean_files +ac_clean_files="$ac_clean_files a.out a.out.dSYM a.exe b.out" +# Try to create an executable without -o first, disregard a.out. +# It will help us diagnose broken compilers, and finding out an intuition +# of exeext. +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking whether the C compiler works" >&5 +printf %s "checking whether the C compiler works... " >&6; } +ac_link_default=`printf "%s\n" "$ac_link" | sed 's/ -o *conftest[^ ]*//'` + +# The possible output files: +ac_files="a.out conftest.exe conftest a.exe a_out.exe b.out conftest.*" + +ac_rmfiles= +for ac_file in $ac_files +do + case $ac_file in + *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM | *.o | *.obj ) ;; + * ) ac_rmfiles="$ac_rmfiles $ac_file";; + esac +done +rm -f $ac_rmfiles + +if { { ac_try="$ac_link_default" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +printf "%s\n" "$ac_try_echo"; } >&5 + (eval "$ac_link_default") 2>&5 + ac_status=$? + printf "%s\n" "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } +then : + # Autoconf-2.13 could set the ac_cv_exeext variable to `no'. +# So ignore a value of `no', otherwise this would lead to `EXEEXT = no' +# in a Makefile. We should not override ac_cv_exeext if it was cached, +# so that the user can short-circuit this test for compilers unknown to +# Autoconf. +for ac_file in $ac_files '' +do + test -f "$ac_file" || continue + case $ac_file in + *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM | *.o | *.obj ) + ;; + [ab].out ) + # We found the default executable, but exeext='' is most + # certainly right. + break;; + *.* ) + if test ${ac_cv_exeext+y} && test "$ac_cv_exeext" != no; + then :; else + ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'` + fi + # We set ac_cv_exeext here because the later test for it is not + # safe: cross compilers may not add the suffix if given an `-o' + # argument, so we may need to know it at that point already. + # Even if this section looks crufty: it has the advantage of + # actually working. + break;; + * ) + break;; + esac +done +test "$ac_cv_exeext" = no && ac_cv_exeext= + +else $as_nop + ac_file='' +fi +if test -z "$ac_file" +then : + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 +printf "%s\n" "no" >&6; } +printf "%s\n" "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +{ { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +printf "%s\n" "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error 77 "C compiler cannot create executables +See \`config.log' for more details" "$LINENO" 5; } +else $as_nop + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +printf "%s\n" "yes" >&6; } +fi +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for C compiler default output file name" >&5 +printf %s "checking for C compiler default output file name... " >&6; } +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_file" >&5 +printf "%s\n" "$ac_file" >&6; } +ac_exeext=$ac_cv_exeext + +rm -f -r a.out a.out.dSYM a.exe conftest$ac_cv_exeext b.out +ac_clean_files=$ac_clean_files_save +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for suffix of executables" >&5 +printf %s "checking for suffix of executables... " >&6; } +if { { ac_try="$ac_link" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +printf "%s\n" "$ac_try_echo"; } >&5 + (eval "$ac_link") 2>&5 + ac_status=$? + printf "%s\n" "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } +then : + # If both `conftest.exe' and `conftest' are `present' (well, observable) +# catch `conftest.exe'. For instance with Cygwin, `ls conftest' will +# work properly (i.e., refer to `conftest.exe'), while it won't with +# `rm'. +for ac_file in conftest.exe conftest conftest.*; do + test -f "$ac_file" || continue + case $ac_file in + *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM | *.o | *.obj ) ;; + *.* ) ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'` + break;; + * ) break;; + esac +done +else $as_nop + { { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +printf "%s\n" "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error $? "cannot compute suffix of executables: cannot compile and link +See \`config.log' for more details" "$LINENO" 5; } +fi +rm -f conftest conftest$ac_cv_exeext +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_exeext" >&5 +printf "%s\n" "$ac_cv_exeext" >&6; } + +rm -f conftest.$ac_ext +EXEEXT=$ac_cv_exeext +ac_exeext=$EXEEXT +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include +int +main (void) +{ +FILE *f = fopen ("conftest.out", "w"); + return ferror (f) || fclose (f) != 0; + + ; + return 0; +} +_ACEOF +ac_clean_files="$ac_clean_files conftest.out" +# Check that the compiler produces executables we can run. If not, either +# the compiler is broken, or we cross compile. +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking whether we are cross compiling" >&5 +printf %s "checking whether we are cross compiling... " >&6; } +if test "$cross_compiling" != yes; then + { { ac_try="$ac_link" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +printf "%s\n" "$ac_try_echo"; } >&5 + (eval "$ac_link") 2>&5 + ac_status=$? + printf "%s\n" "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } + if { ac_try='./conftest$ac_cv_exeext' + { { case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +printf "%s\n" "$ac_try_echo"; } >&5 + (eval "$ac_try") 2>&5 + ac_status=$? + printf "%s\n" "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; }; }; then + cross_compiling=no + else + if test "$cross_compiling" = maybe; then + cross_compiling=yes + else + { { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +printf "%s\n" "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error 77 "cannot run C compiled programs. +If you meant to cross compile, use \`--host'. +See \`config.log' for more details" "$LINENO" 5; } + fi + fi +fi +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $cross_compiling" >&5 +printf "%s\n" "$cross_compiling" >&6; } + +rm -f conftest.$ac_ext conftest$ac_cv_exeext conftest.out +ac_clean_files=$ac_clean_files_save +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for suffix of object files" >&5 +printf %s "checking for suffix of object files... " >&6; } +if test ${ac_cv_objext+y} +then : + printf %s "(cached) " >&6 +else $as_nop + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main (void) +{ + + ; + return 0; +} +_ACEOF +rm -f conftest.o conftest.obj +if { { ac_try="$ac_compile" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +printf "%s\n" "$ac_try_echo"; } >&5 + (eval "$ac_compile") 2>&5 + ac_status=$? + printf "%s\n" "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } +then : + for ac_file in conftest.o conftest.obj conftest.*; do + test -f "$ac_file" || continue; + case $ac_file in + *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM ) ;; + *) ac_cv_objext=`expr "$ac_file" : '.*\.\(.*\)'` + break;; + esac +done +else $as_nop + printf "%s\n" "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +{ { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +printf "%s\n" "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error $? "cannot compute suffix of object files: cannot compile +See \`config.log' for more details" "$LINENO" 5; } +fi +rm -f conftest.$ac_cv_objext conftest.$ac_ext +fi +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_objext" >&5 +printf "%s\n" "$ac_cv_objext" >&6; } +OBJEXT=$ac_cv_objext +ac_objext=$OBJEXT +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking whether the compiler supports GNU C" >&5 +printf %s "checking whether the compiler supports GNU C... " >&6; } +if test ${ac_cv_c_compiler_gnu+y} +then : + printf %s "(cached) " >&6 +else $as_nop + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main (void) +{ +#ifndef __GNUC__ + choke me +#endif + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO" +then : + ac_compiler_gnu=yes +else $as_nop + ac_compiler_gnu=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext +ac_cv_c_compiler_gnu=$ac_compiler_gnu + +fi +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_c_compiler_gnu" >&5 +printf "%s\n" "$ac_cv_c_compiler_gnu" >&6; } +ac_compiler_gnu=$ac_cv_c_compiler_gnu + +if test $ac_compiler_gnu = yes; then + GCC=yes +else + GCC= +fi +ac_test_CFLAGS=${CFLAGS+y} +ac_save_CFLAGS=$CFLAGS +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking whether $CC accepts -g" >&5 +printf %s "checking whether $CC accepts -g... " >&6; } +if test ${ac_cv_prog_cc_g+y} +then : + printf %s "(cached) " >&6 +else $as_nop + ac_save_c_werror_flag=$ac_c_werror_flag + ac_c_werror_flag=yes + ac_cv_prog_cc_g=no + CFLAGS="-g" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main (void) +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO" +then : + ac_cv_prog_cc_g=yes +else $as_nop + CFLAGS="" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main (void) +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO" +then : + +else $as_nop + ac_c_werror_flag=$ac_save_c_werror_flag + CFLAGS="-g" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main (void) +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO" +then : + ac_cv_prog_cc_g=yes +fi +rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext +fi +rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext +fi +rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext + ac_c_werror_flag=$ac_save_c_werror_flag +fi +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_g" >&5 +printf "%s\n" "$ac_cv_prog_cc_g" >&6; } +if test $ac_test_CFLAGS; then + CFLAGS=$ac_save_CFLAGS +elif test $ac_cv_prog_cc_g = yes; then + if test "$GCC" = yes; then + CFLAGS="-g -O2" + else + CFLAGS="-g" + fi +else + if test "$GCC" = yes; then + CFLAGS="-O2" + else + CFLAGS= + fi +fi +ac_prog_cc_stdc=no +if test x$ac_prog_cc_stdc = xno +then : + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $CC option to enable C11 features" >&5 +printf %s "checking for $CC option to enable C11 features... " >&6; } +if test ${ac_cv_prog_cc_c11+y} +then : + printf %s "(cached) " >&6 +else $as_nop + ac_cv_prog_cc_c11=no +ac_save_CC=$CC +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +$ac_c_conftest_c11_program +_ACEOF +for ac_arg in '' -std=gnu11 +do + CC="$ac_save_CC $ac_arg" + if ac_fn_c_try_compile "$LINENO" +then : + ac_cv_prog_cc_c11=$ac_arg +fi +rm -f core conftest.err conftest.$ac_objext conftest.beam + test "x$ac_cv_prog_cc_c11" != "xno" && break +done +rm -f conftest.$ac_ext +CC=$ac_save_CC +fi + +if test "x$ac_cv_prog_cc_c11" = xno +then : + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: unsupported" >&5 +printf "%s\n" "unsupported" >&6; } +else $as_nop + if test "x$ac_cv_prog_cc_c11" = x +then : + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: none needed" >&5 +printf "%s\n" "none needed" >&6; } +else $as_nop + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_c11" >&5 +printf "%s\n" "$ac_cv_prog_cc_c11" >&6; } + CC="$CC $ac_cv_prog_cc_c11" +fi + ac_cv_prog_cc_stdc=$ac_cv_prog_cc_c11 + ac_prog_cc_stdc=c11 +fi +fi +if test x$ac_prog_cc_stdc = xno +then : + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $CC option to enable C99 features" >&5 +printf %s "checking for $CC option to enable C99 features... " >&6; } +if test ${ac_cv_prog_cc_c99+y} +then : + printf %s "(cached) " >&6 +else $as_nop + ac_cv_prog_cc_c99=no +ac_save_CC=$CC +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +$ac_c_conftest_c99_program +_ACEOF +for ac_arg in '' -std=gnu99 -std=c99 -c99 -qlanglvl=extc1x -qlanglvl=extc99 -AC99 -D_STDC_C99= +do + CC="$ac_save_CC $ac_arg" + if ac_fn_c_try_compile "$LINENO" +then : + ac_cv_prog_cc_c99=$ac_arg +fi +rm -f core conftest.err conftest.$ac_objext conftest.beam + test "x$ac_cv_prog_cc_c99" != "xno" && break +done +rm -f conftest.$ac_ext +CC=$ac_save_CC +fi + +if test "x$ac_cv_prog_cc_c99" = xno +then : + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: unsupported" >&5 +printf "%s\n" "unsupported" >&6; } +else $as_nop + if test "x$ac_cv_prog_cc_c99" = x +then : + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: none needed" >&5 +printf "%s\n" "none needed" >&6; } +else $as_nop + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_c99" >&5 +printf "%s\n" "$ac_cv_prog_cc_c99" >&6; } + CC="$CC $ac_cv_prog_cc_c99" +fi + ac_cv_prog_cc_stdc=$ac_cv_prog_cc_c99 + ac_prog_cc_stdc=c99 +fi +fi +if test x$ac_prog_cc_stdc = xno +then : + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $CC option to enable C89 features" >&5 +printf %s "checking for $CC option to enable C89 features... " >&6; } +if test ${ac_cv_prog_cc_c89+y} +then : + printf %s "(cached) " >&6 +else $as_nop + ac_cv_prog_cc_c89=no +ac_save_CC=$CC +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +$ac_c_conftest_c89_program +_ACEOF +for ac_arg in '' -qlanglvl=extc89 -qlanglvl=ansi -std -Ae "-Aa -D_HPUX_SOURCE" "-Xc -D__EXTENSIONS__" +do + CC="$ac_save_CC $ac_arg" + if ac_fn_c_try_compile "$LINENO" +then : + ac_cv_prog_cc_c89=$ac_arg +fi +rm -f core conftest.err conftest.$ac_objext conftest.beam + test "x$ac_cv_prog_cc_c89" != "xno" && break +done +rm -f conftest.$ac_ext +CC=$ac_save_CC +fi + +if test "x$ac_cv_prog_cc_c89" = xno +then : + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: unsupported" >&5 +printf "%s\n" "unsupported" >&6; } +else $as_nop + if test "x$ac_cv_prog_cc_c89" = x +then : + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: none needed" >&5 +printf "%s\n" "none needed" >&6; } +else $as_nop + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_c89" >&5 +printf "%s\n" "$ac_cv_prog_cc_c89" >&6; } + CC="$CC $ac_cv_prog_cc_c89" +fi + ac_cv_prog_cc_stdc=$ac_cv_prog_cc_c89 + ac_prog_cc_stdc=c89 +fi +fi + +ac_ext=cpp +ac_cpp='$CXXCPP $CPPFLAGS' +ac_compile='$CXX -c $CXXFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CXX -o conftest$ac_exeext $CXXFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_cxx_compiler_gnu + +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking how to run the C preprocessor" >&5 +printf %s "checking how to run the C preprocessor... " >&6; } +# On Suns, sometimes $CPP names a directory. +if test -n "$CPP" && test -d "$CPP"; then + CPP= +fi +if test -z "$CPP"; then + if test ${ac_cv_prog_CPP+y} +then : + printf %s "(cached) " >&6 +else $as_nop + # Double quotes because $CC needs to be expanded + for CPP in "$CC -E" "$CC -E -traditional-cpp" cpp /lib/cpp + do + ac_preproc_ok=false +for ac_c_preproc_warn_flag in '' yes +do + # Use a header file that comes with gcc, so configuring glibc + # with a fresh cross-compiler works. + # On the NeXT, cc -E runs the code through the compiler's parser, + # not just through cpp. "Syntax error" is here to catch this case. + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include + Syntax error +_ACEOF +if ac_fn_c_try_cpp "$LINENO" +then : + +else $as_nop + # Broken: fails on valid input. +continue +fi +rm -f conftest.err conftest.i conftest.$ac_ext + + # OK, works on sane cases. Now check whether nonexistent headers + # can be detected and how. + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include +_ACEOF +if ac_fn_c_try_cpp "$LINENO" +then : + # Broken: success on invalid input. +continue +else $as_nop + # Passes both tests. +ac_preproc_ok=: +break +fi +rm -f conftest.err conftest.i conftest.$ac_ext + +done +# Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped. +rm -f conftest.i conftest.err conftest.$ac_ext +if $ac_preproc_ok +then : + break +fi + + done + ac_cv_prog_CPP=$CPP + +fi + CPP=$ac_cv_prog_CPP +else + ac_cv_prog_CPP=$CPP +fi +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $CPP" >&5 +printf "%s\n" "$CPP" >&6; } +ac_preproc_ok=false +for ac_c_preproc_warn_flag in '' yes +do + # Use a header file that comes with gcc, so configuring glibc + # with a fresh cross-compiler works. + # On the NeXT, cc -E runs the code through the compiler's parser, + # not just through cpp. "Syntax error" is here to catch this case. + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include + Syntax error +_ACEOF +if ac_fn_c_try_cpp "$LINENO" +then : + +else $as_nop + # Broken: fails on valid input. +continue +fi +rm -f conftest.err conftest.i conftest.$ac_ext + + # OK, works on sane cases. Now check whether nonexistent headers + # can be detected and how. + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include +_ACEOF +if ac_fn_c_try_cpp "$LINENO" +then : + # Broken: success on invalid input. +continue +else $as_nop + # Passes both tests. +ac_preproc_ok=: +break +fi +rm -f conftest.err conftest.i conftest.$ac_ext + +done +# Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped. +rm -f conftest.i conftest.err conftest.$ac_ext +if $ac_preproc_ok +then : + +else $as_nop + { { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +printf "%s\n" "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error $? "C preprocessor \"$CPP\" fails sanity check +See \`config.log' for more details" "$LINENO" 5; } +fi + +ac_ext=cpp +ac_cpp='$CXXCPP $CPPFLAGS' +ac_compile='$CXX -c $CXXFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CXX -o conftest$ac_exeext $CXXFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_cxx_compiler_gnu + + +#determine the OS +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking Is OPENMP avaialble? " >&5 +printf %s "checking Is OPENMP avaialble? ... " >&6; } +OS_FLAG="$(uname)" +if test x"${OS_FLAG}" == x"Darwin";then + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 +printf "%s\n" "no" >&6; } + OPENMP="" +else + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +printf "%s\n" "yes" >&6; } + OPENMP="\$(SHLIB_OPENMP_CXXFLAGS) " +fi + +# Extract the first word of "gsl-config", so it can be a program name with args. +set dummy gsl-config; ac_word=$2 +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +printf %s "checking for $ac_word... " >&6; } +if test ${ac_cv_path_GSL_CONFIG+y} +then : + printf %s "(cached) " >&6 +else $as_nop + case $GSL_CONFIG in + [\\/]* | ?:[\\/]*) + ac_cv_path_GSL_CONFIG="$GSL_CONFIG" # Let the user override the test with a path. + ;; + *) + as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + case $as_dir in #((( + '') as_dir=./ ;; + */) ;; + *) as_dir=$as_dir/ ;; + esac + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir$ac_word$ac_exec_ext"; then + ac_cv_path_GSL_CONFIG="$as_dir$ac_word$ac_exec_ext" + printf "%s\n" "$as_me:${as_lineno-$LINENO}: found $as_dir$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + + ;; +esac +fi +GSL_CONFIG=$ac_cv_path_GSL_CONFIG +if test -n "$GSL_CONFIG"; then + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $GSL_CONFIG" >&5 +printf "%s\n" "$GSL_CONFIG" >&6; } +else + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 +printf "%s\n" "no" >&6; } +fi + + +## If gsl-config was found, let's use it +if test "${GSL_CONFIG}" != ""; then + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +printf "%s\n" "yes" >&6; } + # Use gsl-config for header and linker arguments + gsl_include=$(gsl-config --cflags) + gsl_libs=$(gsl-config --libs) +else + as_fn_error $? "gsl-config not found, is GSL installed? + To install GSL in Ubuntu Type: + sudo apt install gsl + To install GSL in Fedora Type: + sudo yum -y install gsl + To iinstall GSL on macOS using homebrew type: + brew install gsl + " "$LINENO" 5 +fi + +## Can we use pkg-config? +# Extract the first word of "pkg-config", so it can be a program name with args. +set dummy pkg-config; ac_word=$2 +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +printf %s "checking for $ac_word... " >&6; } +if test ${ac_cv_path_have_pkg_config+y} +then : + printf %s "(cached) " >&6 +else $as_nop + case $have_pkg_config in + [\\/]* | ?:[\\/]*) + ac_cv_path_have_pkg_config="$have_pkg_config" # Let the user override the test with a path. + ;; + *) + as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + case $as_dir in #((( + '') as_dir=./ ;; + */) ;; + *) as_dir=$as_dir/ ;; + esac + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir$ac_word$ac_exec_ext"; then + ac_cv_path_have_pkg_config="$as_dir$ac_word$ac_exec_ext" + printf "%s\n" "$as_me:${as_lineno-$LINENO}: found $as_dir$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + + test -z "$ac_cv_path_have_pkg_config" && ac_cv_path_have_pkg_config="no" + ;; +esac +fi +have_pkg_config=$ac_cv_path_have_pkg_config +if test -n "$have_pkg_config"; then + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $have_pkg_config" >&5 +printf "%s\n" "$have_pkg_config" >&6; } +else + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 +printf "%s\n" "no" >&6; } +fi + + +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking Is pkg-config avaialble? " >&5 +printf %s "checking Is pkg-config avaialble? ... " >&6; } +if test x"${have_pkg_config}" != x"no"; then + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +printf "%s\n" "yes" >&6; } + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking if pkg-config knows NLopt" >&5 +printf %s "checking if pkg-config knows NLopt... " >&6; } + if pkg-config --exists nlopt; then + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +printf "%s\n" "yes" >&6; } + ## Since nlopt has been found, test for minimal version requirement + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for pkg-config checking NLopt version" >&5 +printf %s "checking for pkg-config checking NLopt version... " >&6; } + if pkg-config --atleast-version=2.6.0 nlopt; then + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: >= 2.6.0" >&5 +printf "%s\n" ">= 2.6.0" >&6; } + nlopt_include=$(pkg-config --cflags nlopt) + nlopt_libs=$(pkg-config --libs nlopt) + NLOPT_INCLUDE="${nlopt_include}" + + NLOPT_LIBS="${nlopt_libs}" + + else + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 +printf "%s\n" "no" >&6; } + #if it is macOS just try link and use nlopt generically + need_to_build="yes" + fi + else + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 +printf "%s\n" "no" >&6; } + #if it is macOS just try link and use nlopt generically + if test x"${OS_FLAG}" == x"Darwin";then + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: >= 2.6.0" >&5 +printf "%s\n" ">= 2.6.0" >&6; } + nlopt_include="" + nlopt_libs="-lnlopt" + NLOPT_INCLUDE="${nlopt_include}" + + NLOPT_LIBS="${nlopt_libs}" + + else + need_to_build="yes" + fi + + fi + +else + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 +printf "%s\n" "no" >&6; } + need_to_build="yes" +fi + +## So do we need to build +if test x"${need_to_build}" != x"no"; then + # Extract the first word of "cmake", so it can be a program name with args. +set dummy cmake; ac_word=$2 +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +printf %s "checking for $ac_word... " >&6; } +if test ${ac_cv_path_have_cmake+y} +then : + printf %s "(cached) " >&6 +else $as_nop + case $have_cmake in + [\\/]* | ?:[\\/]*) + ac_cv_path_have_cmake="$have_cmake" # Let the user override the test with a path. + ;; + *) + as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + case $as_dir in #((( + '') as_dir=./ ;; + */) ;; + *) as_dir=$as_dir/ ;; + esac + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir$ac_word$ac_exec_ext"; then + ac_cv_path_have_cmake="$as_dir$ac_word$ac_exec_ext" + printf "%s\n" "$as_me:${as_lineno-$LINENO}: found $as_dir$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + + test -z "$ac_cv_path_have_cmake" && ac_cv_path_have_cmake="no" + ;; +esac +fi +have_cmake=$ac_cv_path_have_cmake +if test -n "$have_cmake"; then + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $have_cmake" >&5 +printf "%s\n" "$have_cmake" >&6; } +else + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 +printf "%s\n" "no" >&6; } +fi + + + if test x"${have_cmake}" == x"no"; then + . src/scripts/cmake_config.sh + if test -z "${CMAKE_BIN}"; then + ## also error to end configure here + as_fn_error $? "Could not find 'cmake'." "$LINENO" 5 + fi + fi + ## 'uname -m' on M1 give x86_64 which is ... not helping + machine=`"${R_HOME}/bin/Rscript" -e 'cat(Sys.info()["machine"])'` + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: using NLopt via local cmake build on ${machine} " >&5 +printf "%s\n" "using NLopt via local cmake build on ${machine} " >&6; } + tools/cmake_call.sh + ## cmake_call.sh installs into nlopt/lib, headers are copied + nlopt_include="-I./nlopt/include" + nlopt_libs="-L./nlopt/lib -lnlopt" +fi + +SUBDIR_SOURCES="$(cd src/ && ls {code_base,polyK}/*.cpp | tr '\n' ' ')" +SRC_SOURCES="$( cd src/ && ls *.cpp | tr '\n' ' ')" + + + + +NLOPT_CPPFLAGS="${nlopt_include}" + +NLOPT_LIBS="${nlopt_libs}" + +GSL_CPPFLAGS="${gsl_include}" + +GSL_LIBS="${gsl_libs}" + +ac_config_files="$ac_config_files src/Makevars" + +cat >confcache <<\_ACEOF +# This file is a shell script that caches the results of configure +# tests run on this system so they can be shared between configure +# scripts and configure runs, see configure's option --config-cache. +# It is not useful on other systems. If it contains results you don't +# want to keep, you may remove or edit it. +# +# config.status only pays attention to the cache file if you give it +# the --recheck option to rerun configure. +# +# `ac_cv_env_foo' variables (set or unset) will be overridden when +# loading this file, other *unset* `ac_cv_foo' will be assigned the +# following values. + +_ACEOF + +# The following way of writing the cache mishandles newlines in values, +# but we know of no workaround that is simple, portable, and efficient. +# So, we kill variables containing newlines. +# Ultrix sh set writes to stderr and can't be redirected directly, +# and sets the high bit in the cache file unless we assign to the vars. +( + for ac_var in `(set) 2>&1 | sed -n 's/^\([a-zA-Z_][a-zA-Z0-9_]*\)=.*/\1/p'`; do + eval ac_val=\$$ac_var + case $ac_val in #( + *${as_nl}*) + case $ac_var in #( + *_cv_*) { printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: cache variable $ac_var contains a newline" >&5 +printf "%s\n" "$as_me: WARNING: cache variable $ac_var contains a newline" >&2;} ;; + esac + case $ac_var in #( + _ | IFS | as_nl) ;; #( + BASH_ARGV | BASH_SOURCE) eval $ac_var= ;; #( + *) { eval $ac_var=; unset $ac_var;} ;; + esac ;; + esac + done + + (set) 2>&1 | + case $as_nl`(ac_space=' '; set) 2>&1` in #( + *${as_nl}ac_space=\ *) + # `set' does not quote correctly, so add quotes: double-quote + # substitution turns \\\\ into \\, and sed turns \\ into \. + sed -n \ + "s/'/'\\\\''/g; + s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\\2'/p" + ;; #( + *) + # `set' quotes correctly as required by POSIX, so do not add quotes. + sed -n "/^[_$as_cr_alnum]*_cv_[_$as_cr_alnum]*=/p" + ;; + esac | + sort +) | + sed ' + /^ac_cv_env_/b end + t clear + :clear + s/^\([^=]*\)=\(.*[{}].*\)$/test ${\1+y} || &/ + t end + s/^\([^=]*\)=\(.*\)$/\1=${\1=\2}/ + :end' >>confcache +if diff "$cache_file" confcache >/dev/null 2>&1; then :; else + if test -w "$cache_file"; then + if test "x$cache_file" != "x/dev/null"; then + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: updating cache $cache_file" >&5 +printf "%s\n" "$as_me: updating cache $cache_file" >&6;} + if test ! -f "$cache_file" || test -h "$cache_file"; then + cat confcache >"$cache_file" + else + case $cache_file in #( + */* | ?:*) + mv -f confcache "$cache_file"$$ && + mv -f "$cache_file"$$ "$cache_file" ;; #( + *) + mv -f confcache "$cache_file" ;; + esac + fi + fi + else + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: not updating unwritable cache $cache_file" >&5 +printf "%s\n" "$as_me: not updating unwritable cache $cache_file" >&6;} + fi +fi +rm -f confcache + +test "x$prefix" = xNONE && prefix=$ac_default_prefix +# Let make expand exec_prefix. +test "x$exec_prefix" = xNONE && exec_prefix='${prefix}' + +# Transform confdefs.h into DEFS. +# Protect against shell expansion while executing Makefile rules. +# Protect against Makefile macro expansion. +# +# If the first sed substitution is executed (which looks for macros that +# take arguments), then branch to the quote section. Otherwise, +# look for a macro that doesn't take arguments. +ac_script=' +:mline +/\\$/{ + N + s,\\\n,, + b mline +} +t clear +:clear +s/^[ ]*#[ ]*define[ ][ ]*\([^ (][^ (]*([^)]*)\)[ ]*\(.*\)/-D\1=\2/g +t quote +s/^[ ]*#[ ]*define[ ][ ]*\([^ ][^ ]*\)[ ]*\(.*\)/-D\1=\2/g +t quote +b any +:quote +s/[ `~#$^&*(){}\\|;'\''"<>?]/\\&/g +s/\[/\\&/g +s/\]/\\&/g +s/\$/$$/g +H +:any +${ + g + s/^\n// + s/\n/ /g + p +} +' +DEFS=`sed -n "$ac_script" confdefs.h` + + +ac_libobjs= +ac_ltlibobjs= +U= +for ac_i in : $LIBOBJS; do test "x$ac_i" = x: && continue + # 1. Remove the extension, and $U if already installed. + ac_script='s/\$U\././;s/\.o$//;s/\.obj$//' + ac_i=`printf "%s\n" "$ac_i" | sed "$ac_script"` + # 2. Prepend LIBOBJDIR. When used with automake>=1.10 LIBOBJDIR + # will be set to the directory where LIBOBJS objects are built. + as_fn_append ac_libobjs " \${LIBOBJDIR}$ac_i\$U.$ac_objext" + as_fn_append ac_ltlibobjs " \${LIBOBJDIR}$ac_i"'$U.lo' +done +LIBOBJS=$ac_libobjs + +LTLIBOBJS=$ac_ltlibobjs + + + +: "${CONFIG_STATUS=./config.status}" +ac_write_fail=0 +ac_clean_files_save=$ac_clean_files +ac_clean_files="$ac_clean_files $CONFIG_STATUS" +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: creating $CONFIG_STATUS" >&5 +printf "%s\n" "$as_me: creating $CONFIG_STATUS" >&6;} +as_write_fail=0 +cat >$CONFIG_STATUS <<_ASEOF || as_write_fail=1 +#! $SHELL +# Generated by $as_me. +# Run this file to recreate the current configuration. +# Compiler output produced by configure, useful for debugging +# configure, is in config.log if it exists. + +debug=false +ac_cs_recheck=false +ac_cs_silent=false + +SHELL=\${CONFIG_SHELL-$SHELL} +export SHELL +_ASEOF +cat >>$CONFIG_STATUS <<\_ASEOF || as_write_fail=1 +## -------------------- ## +## M4sh Initialization. ## +## -------------------- ## + +# Be more Bourne compatible +DUALCASE=1; export DUALCASE # for MKS sh +as_nop=: +if test ${ZSH_VERSION+y} && (emulate sh) >/dev/null 2>&1 +then : + emulate sh + NULLCMD=: + # Pre-4.2 versions of Zsh do word splitting on ${1+"$@"}, which + # is contrary to our usage. Disable this feature. + alias -g '${1+"$@"}'='"$@"' + setopt NO_GLOB_SUBST +else $as_nop + case `(set -o) 2>/dev/null` in #( + *posix*) : + set -o posix ;; #( + *) : + ;; +esac +fi + + + +# Reset variables that may have inherited troublesome values from +# the environment. + +# IFS needs to be set, to space, tab, and newline, in precisely that order. +# (If _AS_PATH_WALK were called with IFS unset, it would have the +# side effect of setting IFS to empty, thus disabling word splitting.) +# Quoting is to prevent editors from complaining about space-tab. +as_nl=' +' +export as_nl +IFS=" "" $as_nl" + +PS1='$ ' +PS2='> ' +PS4='+ ' + +# Ensure predictable behavior from utilities with locale-dependent output. +LC_ALL=C +export LC_ALL +LANGUAGE=C +export LANGUAGE + +# We cannot yet rely on "unset" to work, but we need these variables +# to be unset--not just set to an empty or harmless value--now, to +# avoid bugs in old shells (e.g. pre-3.0 UWIN ksh). This construct +# also avoids known problems related to "unset" and subshell syntax +# in other old shells (e.g. bash 2.01 and pdksh 5.2.14). +for as_var in BASH_ENV ENV MAIL MAILPATH CDPATH +do eval test \${$as_var+y} \ + && ( (unset $as_var) || exit 1) >/dev/null 2>&1 && unset $as_var || : +done + +# Ensure that fds 0, 1, and 2 are open. +if (exec 3>&0) 2>/dev/null; then :; else exec 0&1) 2>/dev/null; then :; else exec 1>/dev/null; fi +if (exec 3>&2) ; then :; else exec 2>/dev/null; fi + +# The user is always right. +if ${PATH_SEPARATOR+false} :; then + PATH_SEPARATOR=: + (PATH='/bin;/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 && { + (PATH='/bin:/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 || + PATH_SEPARATOR=';' + } +fi + + +# Find who we are. Look in the path if we contain no directory separator. +as_myself= +case $0 in #(( + *[\\/]* ) as_myself=$0 ;; + *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + case $as_dir in #((( + '') as_dir=./ ;; + */) ;; + *) as_dir=$as_dir/ ;; + esac + test -r "$as_dir$0" && as_myself=$as_dir$0 && break + done +IFS=$as_save_IFS + + ;; +esac +# We did not find ourselves, most probably we were run as `sh COMMAND' +# in which case we are not to be found in the path. +if test "x$as_myself" = x; then + as_myself=$0 +fi +if test ! -f "$as_myself"; then + printf "%s\n" "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2 + exit 1 +fi + + + +# as_fn_error STATUS ERROR [LINENO LOG_FD] +# ---------------------------------------- +# Output "`basename $0`: error: ERROR" to stderr. If LINENO and LOG_FD are +# provided, also output the error to LOG_FD, referencing LINENO. Then exit the +# script with STATUS, using 1 if that was 0. +as_fn_error () +{ + as_status=$1; test $as_status -eq 0 && as_status=1 + if test "$4"; then + as_lineno=${as_lineno-"$3"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: $2" >&$4 + fi + printf "%s\n" "$as_me: error: $2" >&2 + as_fn_exit $as_status +} # as_fn_error + + + +# as_fn_set_status STATUS +# ----------------------- +# Set $? to STATUS, without forking. +as_fn_set_status () +{ + return $1 +} # as_fn_set_status + +# as_fn_exit STATUS +# ----------------- +# Exit the shell with STATUS, even in a "trap 0" or "set -e" context. +as_fn_exit () +{ + set +e + as_fn_set_status $1 + exit $1 +} # as_fn_exit + +# as_fn_unset VAR +# --------------- +# Portably unset VAR. +as_fn_unset () +{ + { eval $1=; unset $1;} +} +as_unset=as_fn_unset + +# as_fn_append VAR VALUE +# ---------------------- +# Append the text in VALUE to the end of the definition contained in VAR. Take +# advantage of any shell optimizations that allow amortized linear growth over +# repeated appends, instead of the typical quadratic growth present in naive +# implementations. +if (eval "as_var=1; as_var+=2; test x\$as_var = x12") 2>/dev/null +then : + eval 'as_fn_append () + { + eval $1+=\$2 + }' +else $as_nop + as_fn_append () + { + eval $1=\$$1\$2 + } +fi # as_fn_append + +# as_fn_arith ARG... +# ------------------ +# Perform arithmetic evaluation on the ARGs, and store the result in the +# global $as_val. Take advantage of shells that can avoid forks. The arguments +# must be portable across $(()) and expr. +if (eval "test \$(( 1 + 1 )) = 2") 2>/dev/null +then : + eval 'as_fn_arith () + { + as_val=$(( $* )) + }' +else $as_nop + as_fn_arith () + { + as_val=`expr "$@" || test $? -eq 1` + } +fi # as_fn_arith + + +if expr a : '\(a\)' >/dev/null 2>&1 && + test "X`expr 00001 : '.*\(...\)'`" = X001; then + as_expr=expr +else + as_expr=false +fi + +if (basename -- /) >/dev/null 2>&1 && test "X`basename -- / 2>&1`" = "X/"; then + as_basename=basename +else + as_basename=false +fi + +if (as_dir=`dirname -- /` && test "X$as_dir" = X/) >/dev/null 2>&1; then + as_dirname=dirname +else + as_dirname=false +fi + +as_me=`$as_basename -- "$0" || +$as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \ + X"$0" : 'X\(//\)$' \| \ + X"$0" : 'X\(/\)' \| . 2>/dev/null || +printf "%s\n" X/"$0" | + sed '/^.*\/\([^/][^/]*\)\/*$/{ + s//\1/ + q + } + /^X\/\(\/\/\)$/{ + s//\1/ + q + } + /^X\/\(\/\).*/{ + s//\1/ + q + } + s/.*/./; q'` + +# Avoid depending upon Character Ranges. +as_cr_letters='abcdefghijklmnopqrstuvwxyz' +as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ' +as_cr_Letters=$as_cr_letters$as_cr_LETTERS +as_cr_digits='0123456789' +as_cr_alnum=$as_cr_Letters$as_cr_digits + + +# Determine whether it's possible to make 'echo' print without a newline. +# These variables are no longer used directly by Autoconf, but are AC_SUBSTed +# for compatibility with existing Makefiles. +ECHO_C= ECHO_N= ECHO_T= +case `echo -n x` in #((((( +-n*) + case `echo 'xy\c'` in + *c*) ECHO_T=' ';; # ECHO_T is single tab character. + xy) ECHO_C='\c';; + *) echo `echo ksh88 bug on AIX 6.1` > /dev/null + ECHO_T=' ';; + esac;; +*) + ECHO_N='-n';; +esac + +# For backward compatibility with old third-party macros, we provide +# the shell variables $as_echo and $as_echo_n. New code should use +# AS_ECHO(["message"]) and AS_ECHO_N(["message"]), respectively. +as_echo='printf %s\n' +as_echo_n='printf %s' + +rm -f conf$$ conf$$.exe conf$$.file +if test -d conf$$.dir; then + rm -f conf$$.dir/conf$$.file +else + rm -f conf$$.dir + mkdir conf$$.dir 2>/dev/null +fi +if (echo >conf$$.file) 2>/dev/null; then + if ln -s conf$$.file conf$$ 2>/dev/null; then + as_ln_s='ln -s' + # ... but there are two gotchas: + # 1) On MSYS, both `ln -s file dir' and `ln file dir' fail. + # 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable. + # In both cases, we have to default to `cp -pR'. + ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe || + as_ln_s='cp -pR' + elif ln conf$$.file conf$$ 2>/dev/null; then + as_ln_s=ln + else + as_ln_s='cp -pR' + fi +else + as_ln_s='cp -pR' +fi +rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file +rmdir conf$$.dir 2>/dev/null + + +# as_fn_mkdir_p +# ------------- +# Create "$as_dir" as a directory, including parents if necessary. +as_fn_mkdir_p () +{ + + case $as_dir in #( + -*) as_dir=./$as_dir;; + esac + test -d "$as_dir" || eval $as_mkdir_p || { + as_dirs= + while :; do + case $as_dir in #( + *\'*) as_qdir=`printf "%s\n" "$as_dir" | sed "s/'/'\\\\\\\\''/g"`;; #'( + *) as_qdir=$as_dir;; + esac + as_dirs="'$as_qdir' $as_dirs" + as_dir=`$as_dirname -- "$as_dir" || +$as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ + X"$as_dir" : 'X\(//\)[^/]' \| \ + X"$as_dir" : 'X\(//\)$' \| \ + X"$as_dir" : 'X\(/\)' \| . 2>/dev/null || +printf "%s\n" X"$as_dir" | + sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ + s//\1/ + q + } + /^X\(\/\/\)[^/].*/{ + s//\1/ + q + } + /^X\(\/\/\)$/{ + s//\1/ + q + } + /^X\(\/\).*/{ + s//\1/ + q + } + s/.*/./; q'` + test -d "$as_dir" && break + done + test -z "$as_dirs" || eval "mkdir $as_dirs" + } || test -d "$as_dir" || as_fn_error $? "cannot create directory $as_dir" + + +} # as_fn_mkdir_p +if mkdir -p . 2>/dev/null; then + as_mkdir_p='mkdir -p "$as_dir"' +else + test -d ./-p && rmdir ./-p + as_mkdir_p=false +fi + + +# as_fn_executable_p FILE +# ----------------------- +# Test if FILE is an executable regular file. +as_fn_executable_p () +{ + test -f "$1" && test -x "$1" +} # as_fn_executable_p +as_test_x='test -x' +as_executable_p=as_fn_executable_p + +# Sed expression to map a string onto a valid CPP name. +as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'" + +# Sed expression to map a string onto a valid variable name. +as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'" + + +exec 6>&1 +## ----------------------------------- ## +## Main body of $CONFIG_STATUS script. ## +## ----------------------------------- ## +_ASEOF +test $as_write_fail = 0 && chmod +x $CONFIG_STATUS || ac_write_fail=1 + +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +# Save the log message, to keep $0 and so on meaningful, and to +# report actual input values of CONFIG_FILES etc. instead of their +# values after options handling. +ac_log=" +This file was extended by ToxicR $as_me 1.0.1, which was +generated by GNU Autoconf 2.71. Invocation command line was + + CONFIG_FILES = $CONFIG_FILES + CONFIG_HEADERS = $CONFIG_HEADERS + CONFIG_LINKS = $CONFIG_LINKS + CONFIG_COMMANDS = $CONFIG_COMMANDS + $ $0 $@ + +on `(hostname || uname -n) 2>/dev/null | sed 1q` +" + +_ACEOF + +case $ac_config_files in *" +"*) set x $ac_config_files; shift; ac_config_files=$*;; +esac + + + +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 +# Files that config.status was made for. +config_files="$ac_config_files" + +_ACEOF + +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +ac_cs_usage="\ +\`$as_me' instantiates files and other configuration actions +from templates according to the current configuration. Unless the files +and actions are specified as TAGs, all are instantiated by default. + +Usage: $0 [OPTION]... [TAG]... + + -h, --help print this help, then exit + -V, --version print version number and configuration settings, then exit + --config print configuration, then exit + -q, --quiet, --silent + do not print progress messages + -d, --debug don't remove temporary files + --recheck update $as_me by reconfiguring in the same conditions + --file=FILE[:TEMPLATE] + instantiate the configuration file FILE + +Configuration files: +$config_files + +Report bugs to the package provider." + +_ACEOF +ac_cs_config=`printf "%s\n" "$ac_configure_args" | sed "$ac_safe_unquote"` +ac_cs_config_escaped=`printf "%s\n" "$ac_cs_config" | sed "s/^ //; s/'/'\\\\\\\\''/g"` +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 +ac_cs_config='$ac_cs_config_escaped' +ac_cs_version="\\ +ToxicR config.status 1.0.1 +configured by $0, generated by GNU Autoconf 2.71, + with options \\"\$ac_cs_config\\" + +Copyright (C) 2021 Free Software Foundation, Inc. +This config.status script is free software; the Free Software Foundation +gives unlimited permission to copy, distribute and modify it." + +ac_pwd='$ac_pwd' +srcdir='$srcdir' +test -n "\$AWK" || AWK=awk +_ACEOF + +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +# The default lists apply if the user does not specify any file. +ac_need_defaults=: +while test $# != 0 +do + case $1 in + --*=?*) + ac_option=`expr "X$1" : 'X\([^=]*\)='` + ac_optarg=`expr "X$1" : 'X[^=]*=\(.*\)'` + ac_shift=: + ;; + --*=) + ac_option=`expr "X$1" : 'X\([^=]*\)='` + ac_optarg= + ac_shift=: + ;; + *) + ac_option=$1 + ac_optarg=$2 + ac_shift=shift + ;; + esac + + case $ac_option in + # Handling of the options. + -recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r) + ac_cs_recheck=: ;; + --version | --versio | --versi | --vers | --ver | --ve | --v | -V ) + printf "%s\n" "$ac_cs_version"; exit ;; + --config | --confi | --conf | --con | --co | --c ) + printf "%s\n" "$ac_cs_config"; exit ;; + --debug | --debu | --deb | --de | --d | -d ) + debug=: ;; + --file | --fil | --fi | --f ) + $ac_shift + case $ac_optarg in + *\'*) ac_optarg=`printf "%s\n" "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"` ;; + '') as_fn_error $? "missing file argument" ;; + esac + as_fn_append CONFIG_FILES " '$ac_optarg'" + ac_need_defaults=false;; + --he | --h | --help | --hel | -h ) + printf "%s\n" "$ac_cs_usage"; exit ;; + -q | -quiet | --quiet | --quie | --qui | --qu | --q \ + | -silent | --silent | --silen | --sile | --sil | --si | --s) + ac_cs_silent=: ;; + + # This is an error. + -*) as_fn_error $? "unrecognized option: \`$1' +Try \`$0 --help' for more information." ;; + + *) as_fn_append ac_config_targets " $1" + ac_need_defaults=false ;; + + esac + shift +done + +ac_configure_extra_args= + +if $ac_cs_silent; then + exec 6>/dev/null + ac_configure_extra_args="$ac_configure_extra_args --silent" +fi + +_ACEOF +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 +if \$ac_cs_recheck; then + set X $SHELL '$0' $ac_configure_args \$ac_configure_extra_args --no-create --no-recursion + shift + \printf "%s\n" "running CONFIG_SHELL=$SHELL \$*" >&6 + CONFIG_SHELL='$SHELL' + export CONFIG_SHELL + exec "\$@" +fi + +_ACEOF +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +exec 5>>config.log +{ + echo + sed 'h;s/./-/g;s/^.../## /;s/...$/ ##/;p;x;p;x' <<_ASBOX +## Running $as_me. ## +_ASBOX + printf "%s\n" "$ac_log" +} >&5 + +_ACEOF +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 +_ACEOF + +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 + +# Handling of arguments. +for ac_config_target in $ac_config_targets +do + case $ac_config_target in + "src/Makevars") CONFIG_FILES="$CONFIG_FILES src/Makevars" ;; + + *) as_fn_error $? "invalid argument: \`$ac_config_target'" "$LINENO" 5;; + esac +done + + +# If the user did not use the arguments to specify the items to instantiate, +# then the envvar interface is used. Set only those that are not. +# We use the long form for the default assignment because of an extremely +# bizarre bug on SunOS 4.1.3. +if $ac_need_defaults; then + test ${CONFIG_FILES+y} || CONFIG_FILES=$config_files +fi + +# Have a temporary directory for convenience. Make it in the build tree +# simply because there is no reason against having it here, and in addition, +# creating and moving files from /tmp can sometimes cause problems. +# Hook for its removal unless debugging. +# Note that there is a small window in which the directory will not be cleaned: +# after its creation but before its name has been assigned to `$tmp'. +$debug || +{ + tmp= ac_tmp= + trap 'exit_status=$? + : "${ac_tmp:=$tmp}" + { test ! -d "$ac_tmp" || rm -fr "$ac_tmp"; } && exit $exit_status +' 0 + trap 'as_fn_exit 1' 1 2 13 15 +} +# Create a (secure) tmp directory for tmp files. + +{ + tmp=`(umask 077 && mktemp -d "./confXXXXXX") 2>/dev/null` && + test -d "$tmp" +} || +{ + tmp=./conf$$-$RANDOM + (umask 077 && mkdir "$tmp") +} || as_fn_error $? "cannot create a temporary directory in ." "$LINENO" 5 +ac_tmp=$tmp + +# Set up the scripts for CONFIG_FILES section. +# No need to generate them if there are no CONFIG_FILES. +# This happens for instance with `./config.status config.h'. +if test -n "$CONFIG_FILES"; then + + +ac_cr=`echo X | tr X '\015'` +# On cygwin, bash can eat \r inside `` if the user requested igncr. +# But we know of no other shell where ac_cr would be empty at this +# point, so we can use a bashism as a fallback. +if test "x$ac_cr" = x; then + eval ac_cr=\$\'\\r\' +fi +ac_cs_awk_cr=`$AWK 'BEGIN { print "a\rb" }' /dev/null` +if test "$ac_cs_awk_cr" = "a${ac_cr}b"; then + ac_cs_awk_cr='\\r' +else + ac_cs_awk_cr=$ac_cr +fi + +echo 'BEGIN {' >"$ac_tmp/subs1.awk" && +_ACEOF + + +{ + echo "cat >conf$$subs.awk <<_ACEOF" && + echo "$ac_subst_vars" | sed 's/.*/&!$&$ac_delim/' && + echo "_ACEOF" +} >conf$$subs.sh || + as_fn_error $? "could not make $CONFIG_STATUS" "$LINENO" 5 +ac_delim_num=`echo "$ac_subst_vars" | grep -c '^'` +ac_delim='%!_!# ' +for ac_last_try in false false false false false :; do + . ./conf$$subs.sh || + as_fn_error $? "could not make $CONFIG_STATUS" "$LINENO" 5 + + ac_delim_n=`sed -n "s/.*$ac_delim\$/X/p" conf$$subs.awk | grep -c X` + if test $ac_delim_n = $ac_delim_num; then + break + elif $ac_last_try; then + as_fn_error $? "could not make $CONFIG_STATUS" "$LINENO" 5 + else + ac_delim="$ac_delim!$ac_delim _$ac_delim!! " + fi +done +rm -f conf$$subs.sh + +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 +cat >>"\$ac_tmp/subs1.awk" <<\\_ACAWK && +_ACEOF +sed -n ' +h +s/^/S["/; s/!.*/"]=/ +p +g +s/^[^!]*!// +:repl +t repl +s/'"$ac_delim"'$// +t delim +:nl +h +s/\(.\{148\}\)..*/\1/ +t more1 +s/["\\]/\\&/g; s/^/"/; s/$/\\n"\\/ +p +n +b repl +:more1 +s/["\\]/\\&/g; s/^/"/; s/$/"\\/ +p +g +s/.\{148\}// +t nl +:delim +h +s/\(.\{148\}\)..*/\1/ +t more2 +s/["\\]/\\&/g; s/^/"/; s/$/"/ +p +b +:more2 +s/["\\]/\\&/g; s/^/"/; s/$/"\\/ +p +g +s/.\{148\}// +t delim +' >$CONFIG_STATUS || ac_write_fail=1 +rm -f conf$$subs.awk +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 +_ACAWK +cat >>"\$ac_tmp/subs1.awk" <<_ACAWK && + for (key in S) S_is_set[key] = 1 + FS = "" + +} +{ + line = $ 0 + nfields = split(line, field, "@") + substed = 0 + len = length(field[1]) + for (i = 2; i < nfields; i++) { + key = field[i] + keylen = length(key) + if (S_is_set[key]) { + value = S[key] + line = substr(line, 1, len) "" value "" substr(line, len + keylen + 3) + len += length(value) + length(field[++i]) + substed = 1 + } else + len += 1 + keylen + } + + print line +} + +_ACAWK +_ACEOF +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +if sed "s/$ac_cr//" < /dev/null > /dev/null 2>&1; then + sed "s/$ac_cr\$//; s/$ac_cr/$ac_cs_awk_cr/g" +else + cat +fi < "$ac_tmp/subs1.awk" > "$ac_tmp/subs.awk" \ + || as_fn_error $? "could not setup config files machinery" "$LINENO" 5 +_ACEOF + +# VPATH may cause trouble with some makes, so we remove sole $(srcdir), +# ${srcdir} and @srcdir@ entries from VPATH if srcdir is ".", strip leading and +# trailing colons and then remove the whole line if VPATH becomes empty +# (actually we leave an empty line to preserve line numbers). +if test "x$srcdir" = x.; then + ac_vpsub='/^[ ]*VPATH[ ]*=[ ]*/{ +h +s/// +s/^/:/ +s/[ ]*$/:/ +s/:\$(srcdir):/:/g +s/:\${srcdir}:/:/g +s/:@srcdir@:/:/g +s/^:*// +s/:*$// +x +s/\(=[ ]*\).*/\1/ +G +s/\n// +s/^[^=]*=[ ]*$// +}' +fi + +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +fi # test -n "$CONFIG_FILES" + + +eval set X " :F $CONFIG_FILES " +shift +for ac_tag +do + case $ac_tag in + :[FHLC]) ac_mode=$ac_tag; continue;; + esac + case $ac_mode$ac_tag in + :[FHL]*:*);; + :L* | :C*:*) as_fn_error $? "invalid tag \`$ac_tag'" "$LINENO" 5;; + :[FH]-) ac_tag=-:-;; + :[FH]*) ac_tag=$ac_tag:$ac_tag.in;; + esac + ac_save_IFS=$IFS + IFS=: + set x $ac_tag + IFS=$ac_save_IFS + shift + ac_file=$1 + shift + + case $ac_mode in + :L) ac_source=$1;; + :[FH]) + ac_file_inputs= + for ac_f + do + case $ac_f in + -) ac_f="$ac_tmp/stdin";; + *) # Look for the file first in the build tree, then in the source tree + # (if the path is not absolute). The absolute path cannot be DOS-style, + # because $ac_f cannot contain `:'. + test -f "$ac_f" || + case $ac_f in + [\\/$]*) false;; + *) test -f "$srcdir/$ac_f" && ac_f="$srcdir/$ac_f";; + esac || + as_fn_error 1 "cannot find input file: \`$ac_f'" "$LINENO" 5;; + esac + case $ac_f in *\'*) ac_f=`printf "%s\n" "$ac_f" | sed "s/'/'\\\\\\\\''/g"`;; esac + as_fn_append ac_file_inputs " '$ac_f'" + done + + # Let's still pretend it is `configure' which instantiates (i.e., don't + # use $as_me), people would be surprised to read: + # /* config.h. Generated by config.status. */ + configure_input='Generated from '` + printf "%s\n" "$*" | sed 's|^[^:]*/||;s|:[^:]*/|, |g' + `' by configure.' + if test x"$ac_file" != x-; then + configure_input="$ac_file. $configure_input" + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: creating $ac_file" >&5 +printf "%s\n" "$as_me: creating $ac_file" >&6;} + fi + # Neutralize special characters interpreted by sed in replacement strings. + case $configure_input in #( + *\&* | *\|* | *\\* ) + ac_sed_conf_input=`printf "%s\n" "$configure_input" | + sed 's/[\\\\&|]/\\\\&/g'`;; #( + *) ac_sed_conf_input=$configure_input;; + esac + + case $ac_tag in + *:-:* | *:-) cat >"$ac_tmp/stdin" \ + || as_fn_error $? "could not create $ac_file" "$LINENO" 5 ;; + esac + ;; + esac + + ac_dir=`$as_dirname -- "$ac_file" || +$as_expr X"$ac_file" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ + X"$ac_file" : 'X\(//\)[^/]' \| \ + X"$ac_file" : 'X\(//\)$' \| \ + X"$ac_file" : 'X\(/\)' \| . 2>/dev/null || +printf "%s\n" X"$ac_file" | + sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ + s//\1/ + q + } + /^X\(\/\/\)[^/].*/{ + s//\1/ + q + } + /^X\(\/\/\)$/{ + s//\1/ + q + } + /^X\(\/\).*/{ + s//\1/ + q + } + s/.*/./; q'` + as_dir="$ac_dir"; as_fn_mkdir_p + ac_builddir=. + +case "$ac_dir" in +.) ac_dir_suffix= ac_top_builddir_sub=. ac_top_build_prefix= ;; +*) + ac_dir_suffix=/`printf "%s\n" "$ac_dir" | sed 's|^\.[\\/]||'` + # A ".." for each directory in $ac_dir_suffix. + ac_top_builddir_sub=`printf "%s\n" "$ac_dir_suffix" | sed 's|/[^\\/]*|/..|g;s|/||'` + case $ac_top_builddir_sub in + "") ac_top_builddir_sub=. ac_top_build_prefix= ;; + *) ac_top_build_prefix=$ac_top_builddir_sub/ ;; + esac ;; +esac +ac_abs_top_builddir=$ac_pwd +ac_abs_builddir=$ac_pwd$ac_dir_suffix +# for backward compatibility: +ac_top_builddir=$ac_top_build_prefix + +case $srcdir in + .) # We are building in place. + ac_srcdir=. + ac_top_srcdir=$ac_top_builddir_sub + ac_abs_top_srcdir=$ac_pwd ;; + [\\/]* | ?:[\\/]* ) # Absolute name. + ac_srcdir=$srcdir$ac_dir_suffix; + ac_top_srcdir=$srcdir + ac_abs_top_srcdir=$srcdir ;; + *) # Relative name. + ac_srcdir=$ac_top_build_prefix$srcdir$ac_dir_suffix + ac_top_srcdir=$ac_top_build_prefix$srcdir + ac_abs_top_srcdir=$ac_pwd/$srcdir ;; +esac +ac_abs_srcdir=$ac_abs_top_srcdir$ac_dir_suffix + + + case $ac_mode in + :F) + # + # CONFIG_FILE + # + +_ACEOF + +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +# If the template does not know about datarootdir, expand it. +# FIXME: This hack should be removed a few years after 2.60. +ac_datarootdir_hack=; ac_datarootdir_seen= +ac_sed_dataroot=' +/datarootdir/ { + p + q +} +/@datadir@/p +/@docdir@/p +/@infodir@/p +/@localedir@/p +/@mandir@/p' +case `eval "sed -n \"\$ac_sed_dataroot\" $ac_file_inputs"` in +*datarootdir*) ac_datarootdir_seen=yes;; +*@datadir@*|*@docdir@*|*@infodir@*|*@localedir@*|*@mandir@*) + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: $ac_file_inputs seems to ignore the --datarootdir setting" >&5 +printf "%s\n" "$as_me: WARNING: $ac_file_inputs seems to ignore the --datarootdir setting" >&2;} +_ACEOF +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 + ac_datarootdir_hack=' + s&@datadir@&$datadir&g + s&@docdir@&$docdir&g + s&@infodir@&$infodir&g + s&@localedir@&$localedir&g + s&@mandir@&$mandir&g + s&\\\${datarootdir}&$datarootdir&g' ;; +esac +_ACEOF + +# Neutralize VPATH when `$srcdir' = `.'. +# Shell code in configure.ac might set extrasub. +# FIXME: do we really want to maintain this feature? +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 +ac_sed_extra="$ac_vpsub +$extrasub +_ACEOF +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +:t +/@[a-zA-Z_][a-zA-Z_0-9]*@/!b +s|@configure_input@|$ac_sed_conf_input|;t t +s&@top_builddir@&$ac_top_builddir_sub&;t t +s&@top_build_prefix@&$ac_top_build_prefix&;t t +s&@srcdir@&$ac_srcdir&;t t +s&@abs_srcdir@&$ac_abs_srcdir&;t t +s&@top_srcdir@&$ac_top_srcdir&;t t +s&@abs_top_srcdir@&$ac_abs_top_srcdir&;t t +s&@builddir@&$ac_builddir&;t t +s&@abs_builddir@&$ac_abs_builddir&;t t +s&@abs_top_builddir@&$ac_abs_top_builddir&;t t +$ac_datarootdir_hack +" +eval sed \"\$ac_sed_extra\" "$ac_file_inputs" | $AWK -f "$ac_tmp/subs.awk" \ + >$ac_tmp/out || as_fn_error $? "could not create $ac_file" "$LINENO" 5 + +test -z "$ac_datarootdir_hack$ac_datarootdir_seen" && + { ac_out=`sed -n '/\${datarootdir}/p' "$ac_tmp/out"`; test -n "$ac_out"; } && + { ac_out=`sed -n '/^[ ]*datarootdir[ ]*:*=/p' \ + "$ac_tmp/out"`; test -z "$ac_out"; } && + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: $ac_file contains a reference to the variable \`datarootdir' +which seems to be undefined. Please make sure it is defined" >&5 +printf "%s\n" "$as_me: WARNING: $ac_file contains a reference to the variable \`datarootdir' +which seems to be undefined. Please make sure it is defined" >&2;} + + rm -f "$ac_tmp/stdin" + case $ac_file in + -) cat "$ac_tmp/out" && rm -f "$ac_tmp/out";; + *) rm -f "$ac_file" && mv "$ac_tmp/out" "$ac_file";; + esac \ + || as_fn_error $? "could not create $ac_file" "$LINENO" 5 + ;; + + + + esac + +done # for ac_tag + + +as_fn_exit 0 +_ACEOF +ac_clean_files=$ac_clean_files_save + +test $ac_write_fail = 0 || + as_fn_error $? "write failure creating $CONFIG_STATUS" "$LINENO" 5 + + +# configure is writing to config.log, and then calls config.status. +# config.status does its own redirection, appending to config.log. +# Unfortunately, on DOS this fails, as config.log is still kept open +# by configure, so config.status won't be able to write to it; its +# output is simply discarded. So we exec the FD to /dev/null, +# effectively closing config.log, so it can be properly (re)opened and +# appended to by config.status. When coming back to configure, we +# need to make the FD available again. +if test "$no_create" != yes; then + ac_cs_success=: + ac_config_status_args= + test "$silent" = yes && + ac_config_status_args="$ac_config_status_args --quiet" + exec 5>/dev/null + $SHELL $CONFIG_STATUS $ac_config_status_args || ac_cs_success=false + exec 5>>config.log + # Use ||, not &&, to avoid exiting from the if with $? = 1, which + # would make configure fail if this is the last instruction. + $ac_cs_success || as_fn_exit 1 +fi +if test -n "$ac_unrecognized_opts" && test "$enable_option_checking" != no; then + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: unrecognized options: $ac_unrecognized_opts" >&5 +printf "%s\n" "$as_me: WARNING: unrecognized options: $ac_unrecognized_opts" >&2;} +fi + + diff --git a/configure.ac b/configure.ac new file mode 100644 index 0000000..8486293 --- /dev/null +++ b/configure.ac @@ -0,0 +1,115 @@ +# Configure Script for ToxicR +# Modified 4/27/2022 +# Configure Script for ToxicR +# Modified 4/27/2022 + +AC_INIT([ToxicR], 1.0.1) dnl Package version + +CXX=`"${R_HOME}/bin/R" CMD config CXX` +CXXFLAGS=`"${R_HOME}/bin/R" CMD config CXXFLAGS` +CPPFLAGS=`"${R_HOME}/bin/R" CMD config CPPFLAGS` +AC_LANG(C++) +AC_PROG_CPP + +#determine the OS +AC_MSG_CHECKING([Is OPENMP avaialble? ]) +OS_FLAG="$(uname)" +if test x"${OS_FLAG}" == x"Darwin";then + AC_MSG_RESULT([no]) + OPENMP="" +else + AC_MSG_RESULT([yes]) + OPENMP="\$(SHLIB_OPENMP_CXXFLAGS) " +fi + +AC_PATH_PROG([GSL_CONFIG], [gsl-config]) +## If gsl-config was found, let's use it +if test "${GSL_CONFIG}" != ""; then + AC_MSG_RESULT([yes]) + # Use gsl-config for header and linker arguments + gsl_include=$(gsl-config --cflags) + gsl_libs=$(gsl-config --libs) +else + AC_MSG_ERROR([gsl-config not found, is GSL installed? + To install GSL in Ubuntu Type: + sudo apt install gsl + To install GSL in Fedora Type: + sudo yum -y install gsl + To iinstall GSL on macOS using homebrew type: + brew install gsl + ]) +fi + +## Can we use pkg-config? +AC_PATH_PROG(have_pkg_config, pkg-config, no) +AC_MSG_CHECKING([Is pkg-config avaialble? ]) +if test x"${have_pkg_config}" != x"no"; then + AC_MSG_RESULT([yes]) + AC_MSG_CHECKING([if pkg-config knows NLopt]) + if pkg-config --exists nlopt; then + AC_MSG_RESULT([yes]) + ## Since nlopt has been found, test for minimal version requirement + AC_MSG_CHECKING([for pkg-config checking NLopt version]) + if pkg-config --atleast-version=2.6.0 nlopt; then + AC_MSG_RESULT([>= 2.6.0]) + nlopt_include=$(pkg-config --cflags nlopt) + nlopt_libs=$(pkg-config --libs nlopt) + AC_SUBST([NLOPT_INCLUDE], "${nlopt_include}") + AC_SUBST([NLOPT_LIBS], "${nlopt_libs}") + else + AC_MSG_RESULT([no]) + #if it is macOS just try link and use nlopt generically + need_to_build="yes" + fi + else + AC_MSG_RESULT([no]) + #if it is macOS just try link and use nlopt generically + if test x"${OS_FLAG}" == x"Darwin";then + AC_MSG_RESULT([>= 2.6.0]) + nlopt_include="" + nlopt_libs="-lnlopt" + AC_SUBST([NLOPT_INCLUDE], "${nlopt_include}") + AC_SUBST([NLOPT_LIBS], "${nlopt_libs}") + else + need_to_build="yes" + fi + + fi + +else + AC_MSG_RESULT([no]) + need_to_build="yes" +fi + +## So do we need to build +if test x"${need_to_build}" != x"no"; then + AC_PATH_PROG(have_cmake, cmake, no) + + if test x"${have_cmake}" == x"no"; then + . src/scripts/cmake_config.sh + if test -z "${CMAKE_BIN}"; then + ## also error to end configure here + AC_MSG_ERROR([Could not find 'cmake'.]) + fi + fi + ## 'uname -m' on M1 give x86_64 which is ... not helping + machine=`"${R_HOME}/bin/Rscript" -e 'cat(Sys.info()[["machine"]])'` + AC_MSG_RESULT([using NLopt via local cmake build on ${machine} ]) + tools/cmake_call.sh + ## cmake_call.sh installs into nlopt/lib, headers are copied + nlopt_include="-I./nlopt/include" + nlopt_libs="-L./nlopt/lib -lnlopt" +fi + +SUBDIR_SOURCES="$(cd src/ && ls {code_base,polyK}/*.cpp | tr '\n' ' ')" +SRC_SOURCES="$( cd src/ && ls *.cpp | tr '\n' ' ')" + +AC_SUBST(OPENMP) +AC_SUBST(SRC_SOURCES) +AC_SUBST(SUBDIR_SOURCES) +AC_SUBST([NLOPT_CPPFLAGS],["${nlopt_include}"]) +AC_SUBST([NLOPT_LIBS],["${nlopt_libs}"]) +AC_SUBST([GSL_CPPFLAGS],["${gsl_include}"]) +AC_SUBST([GSL_LIBS],["${gsl_libs}"]) +AC_CONFIG_FILES([src/Makevars]) +AC_OUTPUT diff --git a/data/data.RData b/data/data.RData new file mode 100644 index 0000000..617ab7f Binary files /dev/null and b/data/data.RData differ diff --git a/data/hemotology.RData b/data/hemotology.RData new file mode 100644 index 0000000..b5b16a0 Binary files /dev/null and b/data/hemotology.RData differ diff --git a/data/ntp_599.RData b/data/ntp_599.RData new file mode 100644 index 0000000..d2199b8 Binary files /dev/null and b/data/ntp_599.RData differ diff --git a/data/williamCrits.RData b/data/williamCrits.RData deleted file mode 100644 index 7066ce6..0000000 Binary files a/data/williamCrits.RData and /dev/null differ diff --git a/inst/CITATION b/inst/CITATION new file mode 100644 index 0000000..419da5e --- /dev/null +++ b/inst/CITATION @@ -0,0 +1,20 @@ +citHeader("If you use NLopt in work that leads to a publication, we would appreciate it if +you would kindly cite NLopt in your manuscript. Please cite both the NLopt library and the +authors of the specific algorithm(s) that you employed in your work. Cite NLopt as:") + +citEntry(entry="Article", + title = "The NLopt nonlinear-optimization package", + author = personList(as.person("Steven G. Johnson")), + year = "?", + journal = "?", + volume = "?", + number = "?", + pages = "?", + textVersion = "Steven G. Johnson, The NLopt nonlinear-optimization package, https://nlopt.readthedocs.io/en/latest/" ) + +citFooter("The authors and appropriate citations for the specific optimization algorithms +in NLopt are listed in the NLopt Algorithms page.") + + + + diff --git a/inst/include/nlopt.f b/inst/include/nlopt.f new file mode 100644 index 0000000..556454a --- /dev/null +++ b/inst/include/nlopt.f @@ -0,0 +1,110 @@ + integer NLOPT_GN_DIRECT + parameter (NLOPT_GN_DIRECT=0) + integer NLOPT_GN_DIRECT_L + parameter (NLOPT_GN_DIRECT_L=1) + integer NLOPT_GN_DIRECT_L_RAND + parameter (NLOPT_GN_DIRECT_L_RAND=2) + integer NLOPT_GN_DIRECT_NOSCAL + parameter (NLOPT_GN_DIRECT_NOSCAL=3) + integer NLOPT_GN_DIRECT_L_NOSCAL + parameter (NLOPT_GN_DIRECT_L_NOSCAL=4) + integer NLOPT_GN_DIRECT_L_RAND_NOSCAL + parameter (NLOPT_GN_DIRECT_L_RAND_NOSCAL=5) + integer NLOPT_GN_ORIG_DIRECT + parameter (NLOPT_GN_ORIG_DIRECT=6) + integer NLOPT_GN_ORIG_DIRECT_L + parameter (NLOPT_GN_ORIG_DIRECT_L=7) + integer NLOPT_GD_STOGO + parameter (NLOPT_GD_STOGO=8) + integer NLOPT_GD_STOGO_RAND + parameter (NLOPT_GD_STOGO_RAND=9) + integer NLOPT_LD_LBFGS_NOCEDAL + parameter (NLOPT_LD_LBFGS_NOCEDAL=10) + integer NLOPT_LD_LBFGS + parameter (NLOPT_LD_LBFGS=11) + integer NLOPT_LN_PRAXIS + parameter (NLOPT_LN_PRAXIS=12) + integer NLOPT_LD_VAR1 + parameter (NLOPT_LD_VAR1=13) + integer NLOPT_LD_VAR2 + parameter (NLOPT_LD_VAR2=14) + integer NLOPT_LD_TNEWTON + parameter (NLOPT_LD_TNEWTON=15) + integer NLOPT_LD_TNEWTON_RESTART + parameter (NLOPT_LD_TNEWTON_RESTART=16) + integer NLOPT_LD_TNEWTON_PRECOND + parameter (NLOPT_LD_TNEWTON_PRECOND=17) + integer NLOPT_LD_TNEWTON_PRECOND_RESTART + parameter (NLOPT_LD_TNEWTON_PRECOND_RESTART=18) + integer NLOPT_GN_CRS2_LM + parameter (NLOPT_GN_CRS2_LM=19) + integer NLOPT_GN_MLSL + parameter (NLOPT_GN_MLSL=20) + integer NLOPT_GD_MLSL + parameter (NLOPT_GD_MLSL=21) + integer NLOPT_GN_MLSL_LDS + parameter (NLOPT_GN_MLSL_LDS=22) + integer NLOPT_GD_MLSL_LDS + parameter (NLOPT_GD_MLSL_LDS=23) + integer NLOPT_LD_MMA + parameter (NLOPT_LD_MMA=24) + integer NLOPT_LN_COBYLA + parameter (NLOPT_LN_COBYLA=25) + integer NLOPT_LN_NEWUOA + parameter (NLOPT_LN_NEWUOA=26) + integer NLOPT_LN_NEWUOA_BOUND + parameter (NLOPT_LN_NEWUOA_BOUND=27) + integer NLOPT_LN_NELDERMEAD + parameter (NLOPT_LN_NELDERMEAD=28) + integer NLOPT_LN_SBPLX + parameter (NLOPT_LN_SBPLX=29) + integer NLOPT_LN_AUGLAG + parameter (NLOPT_LN_AUGLAG=30) + integer NLOPT_LD_AUGLAG + parameter (NLOPT_LD_AUGLAG=31) + integer NLOPT_LN_AUGLAG_EQ + parameter (NLOPT_LN_AUGLAG_EQ=32) + integer NLOPT_LD_AUGLAG_EQ + parameter (NLOPT_LD_AUGLAG_EQ=33) + integer NLOPT_LN_BOBYQA + parameter (NLOPT_LN_BOBYQA=34) + integer NLOPT_GN_ISRES + parameter (NLOPT_GN_ISRES=35) + integer NLOPT_AUGLAG + parameter (NLOPT_AUGLAG=36) + integer NLOPT_AUGLAG_EQ + parameter (NLOPT_AUGLAG_EQ=37) + integer NLOPT_G_MLSL + parameter (NLOPT_G_MLSL=38) + integer NLOPT_G_MLSL_LDS + parameter (NLOPT_G_MLSL_LDS=39) + integer NLOPT_LD_SLSQP + parameter (NLOPT_LD_SLSQP=40) + integer NLOPT_LD_CCSAQ + parameter (NLOPT_LD_CCSAQ=41) + integer NLOPT_GN_ESCH + parameter (NLOPT_GN_ESCH=42) + integer NLOPT_GN_AGS + parameter (NLOPT_GN_AGS=43) + integer NLOPT_FAILURE + parameter (NLOPT_FAILURE=-1) + integer NLOPT_INVALID_ARGS + parameter (NLOPT_INVALID_ARGS=-2) + integer NLOPT_OUT_OF_MEMORY + parameter (NLOPT_OUT_OF_MEMORY=-3) + integer NLOPT_ROUNDOFF_LIMITED + parameter (NLOPT_ROUNDOFF_LIMITED=-4) + integer NLOPT_FORCED_STOP + parameter (NLOPT_FORCED_STOP=-5) + integer NLOPT_SUCCESS + parameter (NLOPT_SUCCESS=1) + integer NLOPT_STOPVAL_REACHED + parameter (NLOPT_STOPVAL_REACHED=2) + integer NLOPT_FTOL_REACHED + parameter (NLOPT_FTOL_REACHED=3) + integer NLOPT_XTOL_REACHED + parameter (NLOPT_XTOL_REACHED=4) + integer NLOPT_MAXEVAL_REACHED + parameter (NLOPT_MAXEVAL_REACHED=5) + integer NLOPT_MAXTIME_REACHED + parameter (NLOPT_MAXTIME_REACHED=6) diff --git a/inst/include/nlopt.h b/inst/include/nlopt.h new file mode 100644 index 0000000..4f6fb14 --- /dev/null +++ b/inst/include/nlopt.h @@ -0,0 +1,350 @@ +/* Copyright (c) 2007-2014 Massachusetts Institute of Technology + * + * Permission is hereby granted, free of charge, to any person obtaining + * a copy of this software and associated documentation files (the + * "Software"), to deal in the Software without restriction, including + * without limitation the rights to use, copy, modify, merge, publish, + * distribute, sublicense, and/or sell copies of the Software, and to + * permit persons to whom the Software is furnished to do so, subject to + * the following conditions: + * + * The above copyright notice and this permission notice shall be + * included in all copies or substantial portions of the Software. + * + * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, + * EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF + * MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND + * NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE + * LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION + * OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION + * WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. + */ + +#ifndef NLOPT_H +#define NLOPT_H + +#include /* for ptrdiff_t and size_t */ + +/* Change 0 to 1 to use stdcall convention under Win32 */ +#if 0 && (defined(_WIN32) || defined(__WIN32__)) +# if defined(__GNUC__) +# define NLOPT_STDCALL __attribute__((stdcall)) +# elif defined(_MSC_VER) || defined(_ICC) || defined(_STDCALL_SUPPORTED) +# define NLOPT_STDCALL __stdcall +# else +# define NLOPT_STDCALL +# endif +#else +# define NLOPT_STDCALL +#endif + +/* for Windows compilers, you should add a line + #define NLOPT_DLL + when using NLopt from a DLL, in order to do the proper + Windows importing nonsense. */ +#if defined(NLOPT_DLL) && (defined(_WIN32) || defined(__WIN32__)) && !defined(__LCC__) +/* annoying Windows syntax for calling functions in a DLL */ +# if defined(NLOPT_DLL_EXPORT) +# define NLOPT_EXTERN(T) extern __declspec(dllexport) T NLOPT_STDCALL +# else +# define NLOPT_EXTERN(T) extern __declspec(dllimport) T NLOPT_STDCALL +# endif +#else +# define NLOPT_EXTERN(T) extern T NLOPT_STDCALL +#endif + +#ifdef __cplusplus +extern "C" { +#endif /* __cplusplus */ + +typedef double (*nlopt_func) (unsigned n, const double *x, + double *gradient, /* NULL if not needed */ + void *func_data); + +typedef void (*nlopt_mfunc) (unsigned m, double *result, unsigned n, const double *x, + double *gradient, /* NULL if not needed */ + void *func_data); + +/* A preconditioner, which preconditions v at x to return vpre. + (The meaning of "preconditioning" is algorithm-dependent.) */ +typedef void (*nlopt_precond) (unsigned n, const double *x, const double *v, double *vpre, void *data); + +typedef enum { + /* Naming conventions: + + NLOPT_{G/L}{D/N}_* + = global/local derivative/no-derivative optimization, + respectively + + *_RAND algorithms involve some randomization. + + *_NOSCAL algorithms are *not* scaled to a unit hypercube + (i.e. they are sensitive to the units of x) + */ + + NLOPT_GN_DIRECT = 0, + NLOPT_GN_DIRECT_L, + NLOPT_GN_DIRECT_L_RAND, + NLOPT_GN_DIRECT_NOSCAL, + NLOPT_GN_DIRECT_L_NOSCAL, + NLOPT_GN_DIRECT_L_RAND_NOSCAL, + + NLOPT_GN_ORIG_DIRECT, + NLOPT_GN_ORIG_DIRECT_L, + + NLOPT_GD_STOGO, + NLOPT_GD_STOGO_RAND, + + NLOPT_LD_LBFGS_NOCEDAL, + + NLOPT_LD_LBFGS, + + NLOPT_LN_PRAXIS, + + NLOPT_LD_VAR1, + NLOPT_LD_VAR2, + + NLOPT_LD_TNEWTON, + NLOPT_LD_TNEWTON_RESTART, + NLOPT_LD_TNEWTON_PRECOND, + NLOPT_LD_TNEWTON_PRECOND_RESTART, + + NLOPT_GN_CRS2_LM, + + NLOPT_GN_MLSL, + NLOPT_GD_MLSL, + NLOPT_GN_MLSL_LDS, + NLOPT_GD_MLSL_LDS, + + NLOPT_LD_MMA, + + NLOPT_LN_COBYLA, + + NLOPT_LN_NEWUOA, + NLOPT_LN_NEWUOA_BOUND, + + NLOPT_LN_NELDERMEAD, + NLOPT_LN_SBPLX, + + NLOPT_LN_AUGLAG, + NLOPT_LD_AUGLAG, + NLOPT_LN_AUGLAG_EQ, + NLOPT_LD_AUGLAG_EQ, + + NLOPT_LN_BOBYQA, + + NLOPT_GN_ISRES, + + /* new variants that require local_optimizer to be set, + not with older constants for backwards compatibility */ + NLOPT_AUGLAG, + NLOPT_AUGLAG_EQ, + NLOPT_G_MLSL, + NLOPT_G_MLSL_LDS, + + NLOPT_LD_SLSQP, + + NLOPT_LD_CCSAQ, + + NLOPT_GN_ESCH, + + NLOPT_GN_AGS, + + NLOPT_NUM_ALGORITHMS /* not an algorithm, just the number of them */ +} nlopt_algorithm; + +NLOPT_EXTERN(const char *) nlopt_algorithm_name(nlopt_algorithm a); + +/* nlopt_algorithm enum <-> string conversion */ +NLOPT_EXTERN(const char *) nlopt_algorithm_to_string(nlopt_algorithm algorithm); +NLOPT_EXTERN(nlopt_algorithm) nlopt_algorithm_from_string(const char *name); + +typedef enum { + NLOPT_FAILURE = -1, /* generic failure code */ + NLOPT_INVALID_ARGS = -2, + NLOPT_OUT_OF_MEMORY = -3, + NLOPT_ROUNDOFF_LIMITED = -4, + NLOPT_FORCED_STOP = -5, + NLOPT_NUM_FAILURES = -6, /* not a result, just the number of possible failures */ + NLOPT_SUCCESS = 1, /* generic success code */ + NLOPT_STOPVAL_REACHED = 2, + NLOPT_FTOL_REACHED = 3, + NLOPT_XTOL_REACHED = 4, + NLOPT_MAXEVAL_REACHED = 5, + NLOPT_MAXTIME_REACHED = 6, + NLOPT_NUM_RESULTS /* not a result, just the number of possible successes */ +} nlopt_result; + +/* nlopt_result enum <-> string conversion */ +NLOPT_EXTERN(const char *) nlopt_result_to_string(nlopt_result algorithm); +NLOPT_EXTERN(nlopt_result) nlopt_result_from_string(const char *name); + +#define NLOPT_MINF_MAX_REACHED NLOPT_STOPVAL_REACHED + +NLOPT_EXTERN(void) nlopt_srand(unsigned long seed); +NLOPT_EXTERN(void) nlopt_srand_time(void); + +NLOPT_EXTERN(void) nlopt_version(int *major, int *minor, int *bugfix); + +/*************************** OBJECT-ORIENTED API **************************/ +/* The style here is that we create an nlopt_opt "object" (an opaque pointer), + then set various optimization parameters, and then execute the + algorithm. In this way, we can add more and more optimization parameters + (including algorithm-specific ones) without breaking backwards + compatibility, having functions with zillions of parameters, or + relying non-reentrantly on global variables.*/ + +struct nlopt_opt_s; /* opaque structure, defined internally */ +typedef struct nlopt_opt_s *nlopt_opt; + +/* the only immutable parameters of an optimization are the algorithm and + the dimension n of the problem, since changing either of these could + have side-effects on lots of other parameters */ +NLOPT_EXTERN(nlopt_opt) nlopt_create(nlopt_algorithm algorithm, unsigned n); +NLOPT_EXTERN(void) nlopt_destroy(nlopt_opt opt); +NLOPT_EXTERN(nlopt_opt) nlopt_copy(const nlopt_opt opt); + +NLOPT_EXTERN(nlopt_result) nlopt_optimize(nlopt_opt opt, double *x, double *opt_f); + +NLOPT_EXTERN(nlopt_result) nlopt_set_min_objective(nlopt_opt opt, nlopt_func f, void *f_data); +NLOPT_EXTERN(nlopt_result) nlopt_set_max_objective(nlopt_opt opt, nlopt_func f, void *f_data); + +NLOPT_EXTERN(nlopt_result) nlopt_set_precond_min_objective(nlopt_opt opt, nlopt_func f, nlopt_precond pre, void *f_data); +NLOPT_EXTERN(nlopt_result) nlopt_set_precond_max_objective(nlopt_opt opt, nlopt_func f, nlopt_precond pre, void *f_data); + +NLOPT_EXTERN(nlopt_algorithm) nlopt_get_algorithm(const nlopt_opt opt); +NLOPT_EXTERN(unsigned) nlopt_get_dimension(const nlopt_opt opt); + +NLOPT_EXTERN(const char *) nlopt_get_errmsg(nlopt_opt opt); + +/* generic algorithm parameters: */ +NLOPT_EXTERN(nlopt_result) nlopt_set_param(nlopt_opt opt, const char *name, double val); +NLOPT_EXTERN(double) nlopt_get_param(const nlopt_opt opt, const char *name, double defaultval); +NLOPT_EXTERN(int) nlopt_has_param(const nlopt_opt opt, const char *name); +NLOPT_EXTERN(unsigned) nlopt_num_params(const nlopt_opt opt); +NLOPT_EXTERN(const char *) nlopt_nth_param(const nlopt_opt opt, unsigned n); + +/* constraints: */ + +NLOPT_EXTERN(nlopt_result) nlopt_set_lower_bounds(nlopt_opt opt, const double *lb); +NLOPT_EXTERN(nlopt_result) nlopt_set_lower_bounds1(nlopt_opt opt, double lb); +NLOPT_EXTERN(nlopt_result) nlopt_set_lower_bound(nlopt_opt opt, int i, double lb); +NLOPT_EXTERN(nlopt_result) nlopt_get_lower_bounds(const nlopt_opt opt, double *lb); +NLOPT_EXTERN(nlopt_result) nlopt_set_upper_bounds(nlopt_opt opt, const double *ub); +NLOPT_EXTERN(nlopt_result) nlopt_set_upper_bounds1(nlopt_opt opt, double ub); +NLOPT_EXTERN(nlopt_result) nlopt_set_upper_bound(nlopt_opt opt, int i, double ub); +NLOPT_EXTERN(nlopt_result) nlopt_get_upper_bounds(const nlopt_opt opt, double *ub); + +NLOPT_EXTERN(nlopt_result) nlopt_remove_inequality_constraints(nlopt_opt opt); +NLOPT_EXTERN(nlopt_result) nlopt_add_inequality_constraint(nlopt_opt opt, nlopt_func fc, void *fc_data, double tol); +NLOPT_EXTERN(nlopt_result) nlopt_add_precond_inequality_constraint(nlopt_opt opt, nlopt_func fc, nlopt_precond pre, void *fc_data, double tol); +NLOPT_EXTERN(nlopt_result) nlopt_add_inequality_mconstraint(nlopt_opt opt, unsigned m, nlopt_mfunc fc, void *fc_data, const double *tol); + +NLOPT_EXTERN(nlopt_result) nlopt_remove_equality_constraints(nlopt_opt opt); +NLOPT_EXTERN(nlopt_result) nlopt_add_equality_constraint(nlopt_opt opt, nlopt_func h, void *h_data, double tol); +NLOPT_EXTERN(nlopt_result) nlopt_add_precond_equality_constraint(nlopt_opt opt, nlopt_func h, nlopt_precond pre, void *h_data, double tol); +NLOPT_EXTERN(nlopt_result) nlopt_add_equality_mconstraint(nlopt_opt opt, unsigned m, nlopt_mfunc h, void *h_data, const double *tol); + +/* stopping criteria: */ + +NLOPT_EXTERN(nlopt_result) nlopt_set_stopval(nlopt_opt opt, double stopval); +NLOPT_EXTERN(double) nlopt_get_stopval(const nlopt_opt opt); + +NLOPT_EXTERN(nlopt_result) nlopt_set_ftol_rel(nlopt_opt opt, double tol); +NLOPT_EXTERN(double) nlopt_get_ftol_rel(const nlopt_opt opt); +NLOPT_EXTERN(nlopt_result) nlopt_set_ftol_abs(nlopt_opt opt, double tol); +NLOPT_EXTERN(double) nlopt_get_ftol_abs(const nlopt_opt opt); + +NLOPT_EXTERN(nlopt_result) nlopt_set_xtol_rel(nlopt_opt opt, double tol); +NLOPT_EXTERN(double) nlopt_get_xtol_rel(const nlopt_opt opt); +NLOPT_EXTERN(nlopt_result) nlopt_set_xtol_abs1(nlopt_opt opt, double tol); +NLOPT_EXTERN(nlopt_result) nlopt_set_xtol_abs(nlopt_opt opt, const double *tol); +NLOPT_EXTERN(nlopt_result) nlopt_get_xtol_abs(const nlopt_opt opt, double *tol); +NLOPT_EXTERN(nlopt_result) nlopt_set_x_weights1(nlopt_opt opt, double w); +NLOPT_EXTERN(nlopt_result) nlopt_set_x_weights(nlopt_opt opt, const double *w); +NLOPT_EXTERN(nlopt_result) nlopt_get_x_weights(const nlopt_opt opt, double *w); + +NLOPT_EXTERN(nlopt_result) nlopt_set_maxeval(nlopt_opt opt, int maxeval); +NLOPT_EXTERN(int) nlopt_get_maxeval(const nlopt_opt opt); + +NLOPT_EXTERN(int) nlopt_get_numevals(const nlopt_opt opt); + +NLOPT_EXTERN(nlopt_result) nlopt_set_maxtime(nlopt_opt opt, double maxtime); +NLOPT_EXTERN(double) nlopt_get_maxtime(const nlopt_opt opt); + +NLOPT_EXTERN(nlopt_result) nlopt_force_stop(nlopt_opt opt); +NLOPT_EXTERN(nlopt_result) nlopt_set_force_stop(nlopt_opt opt, int val); +NLOPT_EXTERN(int) nlopt_get_force_stop(const nlopt_opt opt); + +/* more algorithm-specific parameters */ + +NLOPT_EXTERN(nlopt_result) nlopt_set_local_optimizer(nlopt_opt opt, const nlopt_opt local_opt); + +NLOPT_EXTERN(nlopt_result) nlopt_set_population(nlopt_opt opt, unsigned pop); +NLOPT_EXTERN(unsigned) nlopt_get_population(const nlopt_opt opt); + +NLOPT_EXTERN(nlopt_result) nlopt_set_vector_storage(nlopt_opt opt, unsigned dim); +NLOPT_EXTERN(unsigned) nlopt_get_vector_storage(const nlopt_opt opt); + +NLOPT_EXTERN(nlopt_result) nlopt_set_default_initial_step(nlopt_opt opt, const double *x); +NLOPT_EXTERN(nlopt_result) nlopt_set_initial_step(nlopt_opt opt, const double *dx); +NLOPT_EXTERN(nlopt_result) nlopt_set_initial_step1(nlopt_opt opt, double dx); +NLOPT_EXTERN(nlopt_result) nlopt_get_initial_step(const nlopt_opt opt, const double *x, double *dx); + +/* the following are functions mainly designed to be used internally + by the Fortran and SWIG wrappers, allow us to tel nlopt_destroy and + nlopt_copy to do something to the f_data pointers (e.g. free or + duplicate them, respectively) */ +typedef void *(*nlopt_munge) (void *p); +NLOPT_EXTERN(void) nlopt_set_munge(nlopt_opt opt, nlopt_munge munge_on_destroy, nlopt_munge munge_on_copy); +typedef void *(*nlopt_munge2) (void *p, void *data); +NLOPT_EXTERN(void) nlopt_munge_data(nlopt_opt opt, nlopt_munge2 munge, void *data); + +/*************************** DEPRECATED API **************************/ +/* The new "object-oriented" API is preferred, since it allows us to + gracefully add new features and algorithm-specific options in a + re-entrant way, and we can automatically assume reasonable defaults + for unspecified parameters. */ + +/* Where possible (e.g. for gcc >= 3.1), enable a compiler warning + for code that uses a deprecated function */ +#if defined(__GNUC__) && (__GNUC__ > 3 || (__GNUC__==3 && __GNUC_MINOR__ > 0)) +# define NLOPT_DEPRECATED __attribute__((deprecated)) +#else +# define NLOPT_DEPRECATED +#endif + +typedef double (*nlopt_func_old) (int n, const double *x, double *gradient, /* NULL if not needed */ + void *func_data); + +NLOPT_EXTERN(nlopt_result) nlopt_minimize(nlopt_algorithm algorithm, int n, nlopt_func_old f, void *f_data, + const double *lb, const double *ub, /* bounds */ + double *x, /* in: initial guess, out: minimizer */ + double *minf, /* out: minimum */ + double minf_max, double ftol_rel, double ftol_abs, double xtol_rel, const double *xtol_abs, int maxeval, double maxtime) NLOPT_DEPRECATED; + +NLOPT_EXTERN(nlopt_result) nlopt_minimize_constrained(nlopt_algorithm algorithm, int n, nlopt_func_old f, void *f_data, int m, nlopt_func_old fc, void *fc_data, ptrdiff_t fc_datum_size, + const double *lb, const double *ub, /* bounds */ + double *x, /* in: initial guess, out: minimizer */ + double *minf, /* out: minimum */ + double minf_max, double ftol_rel, double ftol_abs, double xtol_rel, const double *xtol_abs, int maxeval, double maxtime) NLOPT_DEPRECATED; + +NLOPT_EXTERN(nlopt_result) nlopt_minimize_econstrained(nlopt_algorithm algorithm, int n, nlopt_func_old f, void *f_data, int m, nlopt_func_old fc, void *fc_data, ptrdiff_t fc_datum_size, int p, nlopt_func_old h, void *h_data, ptrdiff_t h_datum_size, + const double *lb, const double *ub, /* bounds */ + double *x, /* in: initial guess, out: minimizer */ + double *minf, /* out: minimum */ + double minf_max, double ftol_rel, double ftol_abs, + double xtol_rel, const double *xtol_abs, double htol_rel, double htol_abs, int maxeval, double maxtime) NLOPT_DEPRECATED; + +NLOPT_EXTERN(void) nlopt_get_local_search_algorithm(nlopt_algorithm * deriv, nlopt_algorithm * nonderiv, int *maxeval) NLOPT_DEPRECATED; +NLOPT_EXTERN(void) nlopt_set_local_search_algorithm(nlopt_algorithm deriv, nlopt_algorithm nonderiv, int maxeval) NLOPT_DEPRECATED; + +NLOPT_EXTERN(int) nlopt_get_stochastic_population(void) NLOPT_DEPRECATED; +NLOPT_EXTERN(void) nlopt_set_stochastic_population(int pop) NLOPT_DEPRECATED; + +/*********************************************************************/ + +#ifdef __cplusplus +} /* extern "C" */ +#endif /* __cplusplus */ +#endif diff --git a/inst/include/nlopt.hpp b/inst/include/nlopt.hpp new file mode 100644 index 0000000..a41c21c --- /dev/null +++ b/inst/include/nlopt.hpp @@ -0,0 +1,575 @@ +/* Copyright (c) 2007-2011 Massachusetts Institute of Technology + * + * Permission is hereby granted, free of charge, to any person obtaining + * a copy of this software and associated documentation files (the + * "Software"), to deal in the Software without restriction, including + * without limitation the rights to use, copy, modify, merge, publish, + * distribute, sublicense, and/or sell copies of the Software, and to + * permit persons to whom the Software is furnished to do so, subject to + * the following conditions: + * + * The above copyright notice and this permission notice shall be + * included in all copies or substantial portions of the Software. + * + * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, + * EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF + * MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND + * NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE + * LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION + * OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION + * WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. + */ +// C++ style wrapper around NLopt API +// nlopt.hpp is AUTOMATICALLY GENERATED from nlopt-in.hpp - edit the latter! +#ifndef NLOPT_HPP +#define NLOPT_HPP +#include +#include +#include +#include +#include +#include +#include +// convenience overloading for below (not in nlopt:: since has nlopt_ prefix) +inline nlopt_result nlopt_get_initial_step(const nlopt_opt opt, double *dx) { + return nlopt_get_initial_step(opt, (const double *) NULL, dx); +} +namespace nlopt { + ////////////////////////////////////////////////////////////////////// + // nlopt::* namespace versions of the C enumerated types + // AUTOMATICALLY GENERATED, DO NOT EDIT + // GEN_ENUMS_HERE + enum algorithm { + GN_DIRECT = 0, + GN_DIRECT_L, + GN_DIRECT_L_RAND, + GN_DIRECT_NOSCAL, + GN_DIRECT_L_NOSCAL, + GN_DIRECT_L_RAND_NOSCAL, + GN_ORIG_DIRECT, + GN_ORIG_DIRECT_L, + GD_STOGO, + GD_STOGO_RAND, + LD_LBFGS_NOCEDAL, + LD_LBFGS, + LN_PRAXIS, + LD_VAR1, + LD_VAR2, + LD_TNEWTON, + LD_TNEWTON_RESTART, + LD_TNEWTON_PRECOND, + LD_TNEWTON_PRECOND_RESTART, + GN_CRS2_LM, + GN_MLSL, + GD_MLSL, + GN_MLSL_LDS, + GD_MLSL_LDS, + LD_MMA, + LN_COBYLA, + LN_NEWUOA, + LN_NEWUOA_BOUND, + LN_NELDERMEAD, + LN_SBPLX, + LN_AUGLAG, + LD_AUGLAG, + LN_AUGLAG_EQ, + LD_AUGLAG_EQ, + LN_BOBYQA, + GN_ISRES, + AUGLAG, + AUGLAG_EQ, + G_MLSL, + G_MLSL_LDS, + LD_SLSQP, + LD_CCSAQ, + GN_ESCH, + GN_AGS, + NUM_ALGORITHMS /* not an algorithm, just the number of them */ + }; + enum result { + FAILURE = -1, /* generic failure code */ + INVALID_ARGS = -2, + OUT_OF_MEMORY = -3, + ROUNDOFF_LIMITED = -4, + FORCED_STOP = -5, + NUM_FAILURES = -6, /* not a result, just the number of possible failures */ + SUCCESS = 1, /* generic success code */ + STOPVAL_REACHED = 2, + FTOL_REACHED = 3, + XTOL_REACHED = 4, + MAXEVAL_REACHED = 5, + MAXTIME_REACHED = 6, + NUM_RESULTS /* not a result, just the number of possible successes */ + }; + ////////////////////////////////////////////////////////////////////// + typedef nlopt_func func; // nlopt::func synoynm + typedef nlopt_mfunc mfunc; // nlopt::mfunc synoynm + // alternative to nlopt_func that takes std::vector + // ... unfortunately requires a data copy + typedef double (*vfunc)(const std::vector &x, + std::vector &grad, void *data); + ////////////////////////////////////////////////////////////////////// + // NLopt-specific exceptions (corresponding to error codes): + class roundoff_limited : public std::runtime_error { + public: + roundoff_limited() : std::runtime_error("nlopt roundoff-limited") {} + }; + class forced_stop : public std::runtime_error { + public: + forced_stop() : std::runtime_error("nlopt forced stop") {} + }; + ////////////////////////////////////////////////////////////////////// + class opt { + private: + nlopt_opt o; + void mythrow(nlopt_result ret) const { + switch (ret) { + case NLOPT_FAILURE: throw std::runtime_error(get_errmsg() ? get_errmsg() : "nlopt failure"); + case NLOPT_OUT_OF_MEMORY: throw std::bad_alloc(); + case NLOPT_INVALID_ARGS: throw std::invalid_argument(get_errmsg() ? get_errmsg() : "nlopt invalid argument"); + case NLOPT_ROUNDOFF_LIMITED: throw roundoff_limited(); + case NLOPT_FORCED_STOP: throw forced_stop(); + default: break; + } + } + typedef struct { + opt *o; + mfunc mf; func f; void *f_data; + vfunc vf; + nlopt_munge munge_destroy, munge_copy; // non-NULL for SWIG wrappers + } myfunc_data; + // free/destroy f_data in nlopt_destroy and nlopt_copy, respectively + static void *free_myfunc_data(void *p) { + myfunc_data *d = (myfunc_data *) p; + if (d) { + if (d->f_data && d->munge_destroy) d->munge_destroy(d->f_data); + delete d; + } + return NULL; + } + static void *dup_myfunc_data(void *p) { + myfunc_data *d = (myfunc_data *) p; + if (d) { + void *f_data; + if (d->f_data && d->munge_copy) { + f_data = d->munge_copy(d->f_data); + if (!f_data) return NULL; + } + else + f_data = d->f_data; + myfunc_data *dnew = new myfunc_data; + if (dnew) { + *dnew = *d; + dnew->f_data = f_data; + } + return (void*) dnew; + } + else return NULL; + } + // nlopt_func wrapper that catches exceptions + static double myfunc(unsigned n, const double *x, double *grad, void *d_) { + myfunc_data *d = reinterpret_cast(d_); + try { + return d->f(n, x, grad, d->f_data); + } + catch (std::bad_alloc&) + { d->o->forced_stop_reason = NLOPT_OUT_OF_MEMORY; } + catch (std::invalid_argument&) + { d->o->forced_stop_reason = NLOPT_INVALID_ARGS; } + catch (roundoff_limited&) + { d->o->forced_stop_reason = NLOPT_ROUNDOFF_LIMITED; } + catch (forced_stop&) + { d->o->forced_stop_reason = NLOPT_FORCED_STOP; } + catch (...) + { d->o->forced_stop_reason = NLOPT_FAILURE; } + d->o->force_stop(); // stop gracefully, opt::optimize will re-throw + return HUGE_VAL; + } + // nlopt_mfunc wrapper that catches exceptions + static void mymfunc(unsigned m, double *result, + unsigned n, const double *x, double *grad, void *d_) { + myfunc_data *d = reinterpret_cast(d_); + try { + d->mf(m, result, n, x, grad, d->f_data); + return; + } + catch (std::bad_alloc&) + { d->o->forced_stop_reason = NLOPT_OUT_OF_MEMORY; } + catch (std::invalid_argument&) + { d->o->forced_stop_reason = NLOPT_INVALID_ARGS; } + catch (roundoff_limited&) + { d->o->forced_stop_reason = NLOPT_ROUNDOFF_LIMITED; } + catch (forced_stop&) + { d->o->forced_stop_reason = NLOPT_FORCED_STOP; } + catch (...) + { d->o->forced_stop_reason = NLOPT_FAILURE; } + d->o->force_stop(); // stop gracefully, opt::optimize will re-throw + for (unsigned i = 0; i < m; ++i) result[i] = HUGE_VAL; + } + std::vector xtmp, gradtmp, gradtmp0; // scratch for myvfunc + // nlopt_func wrapper, using std::vector + static double myvfunc(unsigned n, const double *x, double *grad, void *d_){ + myfunc_data *d = reinterpret_cast(d_); + try { + std::vector &xv = d->o->xtmp; + if (n) std::memcpy(&xv[0], x, n * sizeof(double)); + double val=d->vf(xv, grad ? d->o->gradtmp : d->o->gradtmp0, d->f_data); + if (grad && n) { + std::vector &gradv = d->o->gradtmp; + std::memcpy(grad, &gradv[0], n * sizeof(double)); + } + return val; + } + catch (std::bad_alloc&) + { d->o->forced_stop_reason = NLOPT_OUT_OF_MEMORY; } + catch (std::invalid_argument&) + { d->o->forced_stop_reason = NLOPT_INVALID_ARGS; } + catch (roundoff_limited&) + { d->o->forced_stop_reason = NLOPT_ROUNDOFF_LIMITED; } + catch (forced_stop&) + { d->o->forced_stop_reason = NLOPT_FORCED_STOP; } + catch (...) + { d->o->forced_stop_reason = NLOPT_FAILURE; } + d->o->force_stop(); // stop gracefully, opt::optimize will re-throw + return HUGE_VAL; + } + void alloc_tmp() { + if (xtmp.size() != nlopt_get_dimension(o)) { + xtmp = std::vector(nlopt_get_dimension(o)); + gradtmp = std::vector(nlopt_get_dimension(o)); + } + } + result last_result; + double last_optf; + nlopt_result forced_stop_reason; + public: + // Constructors etc. + opt() : o(NULL), xtmp(0), gradtmp(0), gradtmp0(0), + last_result(nlopt::FAILURE), last_optf(HUGE_VAL), + forced_stop_reason(NLOPT_FORCED_STOP) {} + ~opt() { nlopt_destroy(o); } + opt(algorithm a, unsigned n) : + o(nlopt_create(nlopt_algorithm(a), n)), + xtmp(0), gradtmp(0), gradtmp0(0), + last_result(nlopt::FAILURE), last_optf(HUGE_VAL), + forced_stop_reason(NLOPT_FORCED_STOP) { + if (!o) throw std::bad_alloc(); + nlopt_set_munge(o, free_myfunc_data, dup_myfunc_data); + } + opt(const char * algo_str, unsigned n) : + o(NULL), xtmp(0), gradtmp(0), gradtmp0(0), + last_result(nlopt::FAILURE), last_optf(HUGE_VAL), + forced_stop_reason(NLOPT_FORCED_STOP) { + const nlopt_algorithm a = nlopt_algorithm_from_string(algo_str); + if (a < 0) + throw std::invalid_argument("wrong algorithm string"); + o = nlopt_create(a, n); + if (!o) throw std::bad_alloc(); + nlopt_set_munge(o, free_myfunc_data, dup_myfunc_data); + } + opt(const opt& f) : o(nlopt_copy(f.o)), + xtmp(f.xtmp), gradtmp(f.gradtmp), gradtmp0(0), + last_result(f.last_result), last_optf(f.last_optf), + forced_stop_reason(f.forced_stop_reason) { + if (f.o && !o) throw std::bad_alloc(); + } + opt& operator=(opt const& f) { + if (this == &f) return *this; // self-assignment + nlopt_destroy(o); + o = nlopt_copy(f.o); + if (f.o && !o) throw std::bad_alloc(); + xtmp = f.xtmp; gradtmp = f.gradtmp; + last_result = f.last_result; last_optf = f.last_optf; + forced_stop_reason = f.forced_stop_reason; + return *this; + } + // Do the optimization: + result optimize(std::vector &x, double &opt_f) { + if (o && nlopt_get_dimension(o) != x.size()) + throw std::invalid_argument("dimension mismatch"); + forced_stop_reason = NLOPT_FORCED_STOP; + nlopt_result ret = nlopt_optimize(o, x.empty() ? NULL : &x[0], &opt_f); + last_result = result(ret); + last_optf = opt_f; + if (ret == NLOPT_FORCED_STOP) + mythrow(forced_stop_reason); + mythrow(ret); + return last_result; + } + // variant mainly useful for SWIG wrappers: + std::vector optimize(const std::vector &x0) { + std::vector x(x0); + last_result = optimize(x, last_optf); + return x; + } + result last_optimize_result() const { return last_result; } + double last_optimum_value() const { return last_optf; } + // accessors: + algorithm get_algorithm() const { + if (!o) throw std::runtime_error("uninitialized nlopt::opt"); + return algorithm(nlopt_get_algorithm(o)); + } + const char *get_algorithm_name() const { + if (!o) throw std::runtime_error("uninitialized nlopt::opt"); + return nlopt_algorithm_name(nlopt_get_algorithm(o)); + } + unsigned get_dimension() const { + if (!o) throw std::runtime_error("uninitialized nlopt::opt"); + return nlopt_get_dimension(o); + } + // Set the objective function + void set_min_objective(func f, void *f_data) { + myfunc_data *d = new myfunc_data; + if (!d) throw std::bad_alloc(); + d->o = this; d->f = f; d->f_data = f_data; d->mf = NULL; d->vf = NULL; + d->munge_destroy = d->munge_copy = NULL; + mythrow(nlopt_set_min_objective(o, myfunc, d)); // d freed via o + } + void set_min_objective(vfunc vf, void *f_data) { + myfunc_data *d = new myfunc_data; + if (!d) throw std::bad_alloc(); + d->o = this; d->f = NULL; d->f_data = f_data; d->mf = NULL; d->vf = vf; + d->munge_destroy = d->munge_copy = NULL; + mythrow(nlopt_set_min_objective(o, myvfunc, d)); // d freed via o + alloc_tmp(); + } + void set_max_objective(func f, void *f_data) { + myfunc_data *d = new myfunc_data; + if (!d) throw std::bad_alloc(); + d->o = this; d->f = f; d->f_data = f_data; d->mf = NULL; d->vf = NULL; + d->munge_destroy = d->munge_copy = NULL; + mythrow(nlopt_set_max_objective(o, myfunc, d)); // d freed via o + } + void set_max_objective(vfunc vf, void *f_data) { + myfunc_data *d = new myfunc_data; + if (!d) throw std::bad_alloc(); + d->o = this; d->f = NULL; d->f_data = f_data; d->mf = NULL; d->vf = vf; + d->munge_destroy = d->munge_copy = NULL; + mythrow(nlopt_set_max_objective(o, myvfunc, d)); // d freed via o + alloc_tmp(); + } + // for internal use in SWIG wrappers -- variant that + // takes ownership of f_data, with munging for destroy/copy + void set_min_objective(func f, void *f_data, + nlopt_munge md, nlopt_munge mc) { + myfunc_data *d = new myfunc_data; + if (!d) throw std::bad_alloc(); + d->o = this; d->f = f; d->f_data = f_data; d->mf = NULL; d->vf = NULL; + d->munge_destroy = md; d->munge_copy = mc; + mythrow(nlopt_set_min_objective(o, myfunc, d)); // d freed via o + } + void set_max_objective(func f, void *f_data, + nlopt_munge md, nlopt_munge mc) { + myfunc_data *d = new myfunc_data; + if (!d) throw std::bad_alloc(); + d->o = this; d->f = f; d->f_data = f_data; d->mf = NULL; d->vf = NULL; + d->munge_destroy = md; d->munge_copy = mc; + mythrow(nlopt_set_max_objective(o, myfunc, d)); // d freed via o + } + // Nonlinear constraints: + void remove_inequality_constraints() { + nlopt_result ret = nlopt_remove_inequality_constraints(o); + mythrow(ret); + } + void add_inequality_constraint(func f, void *f_data, double tol=0) { + myfunc_data *d = new myfunc_data; + if (!d) throw std::bad_alloc(); + d->o = this; d->f = f; d->f_data = f_data; d->mf = NULL; d->vf = NULL; + d->munge_destroy = d->munge_copy = NULL; + mythrow(nlopt_add_inequality_constraint(o, myfunc, d, tol)); + } + void add_inequality_constraint(vfunc vf, void *f_data, double tol=0) { + myfunc_data *d = new myfunc_data; + if (!d) throw std::bad_alloc(); + d->o = this; d->f = NULL; d->f_data = f_data; d->mf = NULL; d->vf = vf; + d->munge_destroy = d->munge_copy = NULL; + mythrow(nlopt_add_inequality_constraint(o, myvfunc, d, tol)); + alloc_tmp(); + } + void add_inequality_mconstraint(mfunc mf, void *f_data, + const std::vector &tol) { + myfunc_data *d = new myfunc_data; + if (!d) throw std::bad_alloc(); + d->o = this; d->mf = mf; d->f_data = f_data; d->f = NULL; d->vf = NULL; + d->munge_destroy = d->munge_copy = NULL; + mythrow(nlopt_add_inequality_mconstraint(o, tol.size(), mymfunc, d, + tol.empty() ? NULL : &tol[0])); + } + void remove_equality_constraints() { + nlopt_result ret = nlopt_remove_equality_constraints(o); + mythrow(ret); + } + void add_equality_constraint(func f, void *f_data, double tol=0) { + myfunc_data *d = new myfunc_data; + if (!d) throw std::bad_alloc(); + d->o = this; d->f = f; d->f_data = f_data; d->mf = NULL; d->vf = NULL; + d->munge_destroy = d->munge_copy = NULL; + mythrow(nlopt_add_equality_constraint(o, myfunc, d, tol)); + } + void add_equality_constraint(vfunc vf, void *f_data, double tol=0) { + myfunc_data *d = new myfunc_data; + if (!d) throw std::bad_alloc(); + d->o = this; d->f = NULL; d->f_data = f_data; d->mf = NULL; d->vf = vf; + d->munge_destroy = d->munge_copy = NULL; + mythrow(nlopt_add_equality_constraint(o, myvfunc, d, tol)); + alloc_tmp(); + } + void add_equality_mconstraint(mfunc mf, void *f_data, + const std::vector &tol) { + myfunc_data *d = new myfunc_data; + if (!d) throw std::bad_alloc(); + d->o = this; d->mf = mf; d->f_data = f_data; d->f = NULL; d->vf = NULL; + d->munge_destroy = d->munge_copy = NULL; + mythrow(nlopt_add_equality_mconstraint(o, tol.size(), mymfunc, d, + tol.empty() ? NULL : &tol[0])); + } + // For internal use in SWIG wrappers (see also above) + void add_inequality_constraint(func f, void *f_data, + nlopt_munge md, nlopt_munge mc, + double tol=0) { + myfunc_data *d = new myfunc_data; + if (!d) throw std::bad_alloc(); + d->o = this; d->f = f; d->f_data = f_data; d->mf = NULL; d->vf = NULL; + d->munge_destroy = md; d->munge_copy = mc; + mythrow(nlopt_add_inequality_constraint(o, myfunc, d, tol)); + } + void add_equality_constraint(func f, void *f_data, + nlopt_munge md, nlopt_munge mc, + double tol=0) { + myfunc_data *d = new myfunc_data; + if (!d) throw std::bad_alloc(); + d->o = this; d->f = f; d->f_data = f_data; d->mf = NULL; d->vf = NULL; + d->munge_destroy = md; d->munge_copy = mc; + mythrow(nlopt_add_equality_constraint(o, myfunc, d, tol)); + } + void add_inequality_mconstraint(mfunc mf, void *f_data, + nlopt_munge md, nlopt_munge mc, + const std::vector &tol) { + myfunc_data *d = new myfunc_data; + if (!d) throw std::bad_alloc(); + d->o = this; d->mf = mf; d->f_data = f_data; d->f = NULL; d->vf = NULL; + d->munge_destroy = md; d->munge_copy = mc; + mythrow(nlopt_add_inequality_mconstraint(o, tol.size(), mymfunc, d, + tol.empty() ? NULL : &tol[0])); + } + void add_equality_mconstraint(mfunc mf, void *f_data, + nlopt_munge md, nlopt_munge mc, + const std::vector &tol) { + myfunc_data *d = new myfunc_data; + if (!d) throw std::bad_alloc(); + d->o = this; d->mf = mf; d->f_data = f_data; d->f = NULL; d->vf = NULL; + d->munge_destroy = md; d->munge_copy = mc; + mythrow(nlopt_add_equality_mconstraint(o, tol.size(), mymfunc, d, + tol.empty() ? NULL : &tol[0])); + } + void set_param(const char *name, double val) { mythrow(nlopt_set_param(o, name, val)); } + double get_param(const char *name, double defaultval) const { return nlopt_get_param(o, name, defaultval); } + bool has_param(const char *name) const { return bool(nlopt_has_param(o, name)); } + const char *nth_param(unsigned n) const { return nlopt_nth_param(o, n); } + unsigned num_params() const { return nlopt_num_params(o); } +#define NLOPT_GETSET_VEC(name) \ + void set_##name(double val) { \ + mythrow(nlopt_set_##name##1(o, val)); \ + } \ + void get_##name(std::vector &v) const { \ + if (o && nlopt_get_dimension(o) != v.size()) \ + throw std::invalid_argument("dimension mismatch"); \ + mythrow(nlopt_get_##name(o, v.empty() ? NULL : &v[0])); \ + } \ + std::vector get_##name() const { \ + if (!o) throw std::runtime_error("uninitialized nlopt::opt"); \ + std::vector v(nlopt_get_dimension(o)); \ + get_##name(v); \ + return v; \ + } \ + void set_##name(const std::vector &v) { \ + if (o && nlopt_get_dimension(o) != v.size()) \ + throw std::invalid_argument("dimension mismatch"); \ + mythrow(nlopt_set_##name(o, v.empty() ? NULL : &v[0])); \ + } + NLOPT_GETSET_VEC(lower_bounds) + NLOPT_GETSET_VEC(upper_bounds) + // stopping criteria: +#define NLOPT_GETSET(T, name) \ + T get_##name() const { \ + if (!o) throw std::runtime_error("uninitialized nlopt::opt"); \ + return nlopt_get_##name(o); \ + } \ + void set_##name(T name) { \ + mythrow(nlopt_set_##name(o, name)); \ + } + NLOPT_GETSET(double, stopval) + NLOPT_GETSET(double, ftol_rel) + NLOPT_GETSET(double, ftol_abs) + NLOPT_GETSET(double, xtol_rel) + NLOPT_GETSET_VEC(xtol_abs) + NLOPT_GETSET_VEC(x_weights) + NLOPT_GETSET(int, maxeval) + int get_numevals() const { + if (!o) throw std::runtime_error("uninitialized nlopt::opt"); + return nlopt_get_numevals(o); + } + NLOPT_GETSET(double, maxtime) + NLOPT_GETSET(int, force_stop) + void force_stop() { set_force_stop(1); } + const char *get_errmsg() const { + if (!o) throw std::runtime_error("uninitialized nlopt::opt"); + return nlopt_get_errmsg(o); + } + // algorithm-specific parameters: + void set_local_optimizer(const opt &lo) { + nlopt_result ret = nlopt_set_local_optimizer(o, lo.o); + mythrow(ret); + } + NLOPT_GETSET(unsigned, population) + NLOPT_GETSET(unsigned, vector_storage) + NLOPT_GETSET_VEC(initial_step) + void set_default_initial_step(const std::vector &x) { + nlopt_result ret + = nlopt_set_default_initial_step(o, x.empty() ? NULL : &x[0]); + mythrow(ret); + } + void get_initial_step(const std::vector &x, std::vector &dx) const { + if (o && (nlopt_get_dimension(o) != x.size() + || nlopt_get_dimension(o) != dx.size())) + throw std::invalid_argument("dimension mismatch"); + nlopt_result ret = nlopt_get_initial_step(o, x.empty() ? NULL : &x[0], + dx.empty() ? NULL : &dx[0]); + mythrow(ret); + } + std::vector get_initial_step_(const std::vector &x) const { + if (!o) throw std::runtime_error("uninitialized nlopt::opt"); + std::vector v(nlopt_get_dimension(o)); + get_initial_step(x, v); + return v; + } + }; +#undef NLOPT_GETSET +#undef NLOPT_GETSET_VEC + ////////////////////////////////////////////////////////////////////// + inline void srand(unsigned long seed) { nlopt_srand(seed); } + inline void srand_time() { nlopt_srand_time(); } + inline void version(int &major, int &minor, int &bugfix) { + nlopt_version(&major, &minor, &bugfix); + } + inline int version_major() { + int major, minor, bugfix; + nlopt_version(&major, &minor, &bugfix); + return major; + } + inline int version_minor() { + int major, minor, bugfix; + nlopt_version(&major, &minor, &bugfix); + return minor; + } + inline int version_bugfix() { + int major, minor, bugfix; + nlopt_version(&major, &minor, &bugfix); + return bugfix; + } + inline const char *algorithm_name(algorithm a) { + return nlopt_algorithm_name(nlopt_algorithm(a)); + } + ////////////////////////////////////////////////////////////////////// +} // namespace nlopt +#endif /* NLOPT_HPP */ diff --git a/inst/include/nloptrAPI.h b/inst/include/nloptrAPI.h new file mode 100644 index 0000000..74585ea --- /dev/null +++ b/inst/include/nloptrAPI.h @@ -0,0 +1,459 @@ +/* + * Copyright (C) 2017 Jelmer Ypma. All Rights Reserved. + * This code is published under the L-GPL. + * + * This program is free software: you can redistribute it and/or modify + * it under the terms of the GNU Lesser General Public License as published + * by the Free Software Foundation, either version 3 of the License, or + * (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU Lesser General Public License for more details. + * + * You should have received a copy of the GNU Lesser General Public License + * along with this program. If not, see . + * + * File: nloptrAPI.h + * Author: Jelmer Ypma + * Date: 3 October 2017 + * + * This file provides an API for calling internal NLopt code from C within + * R packages. The C functions that are registered in init_nloptr.c can be + * accessed by external R packages. + * + * 03/10/2017: Initial version exposing nlopt_version. + */ + +#ifndef __NLOPTRAPI_H__ +#define __NLOPTRAPI_H__ + +#include +#include +#include + +#include + +/* + * C functions can be exposed using the following template: + * + * RET_TYPE FUNCNAME(ARGTYPE_1 ARGNAME 1, ARGTYPE_2 ARGNAME_2) + * { + * static RET_TYPE(*fun)(ARGTYPE_1, ARGTYPE_2) = NULL; + * if (fun == NULL) fun = (RET_TYPE(*)(ARGTYPE_1, ARGTYPE_2)) R_GetCCallable("nloptr","FUNCNAME"); + * return fun(ARGNAME_1, ARGNAME_2); + * } + * + */ + +inline NLOPT_EXTERN(const char *) nlopt_algorithm_name(nlopt_algorithm a) +{ + static const char *(*fun)(nlopt_algorithm) = NULL; + if (fun == NULL) fun = (const char *(*)(nlopt_algorithm)) R_GetCCallable("nloptr","nlopt_algorithm_name"); + return fun(a); +} + +inline NLOPT_EXTERN(void) nlopt_srand(unsigned long seed) +{ + static void(*fun)(unsigned long) = NULL; + if (fun == NULL) fun = (void(*)(unsigned long)) R_GetCCallable("nloptr","nlopt_srand"); + return fun(seed); +} + +inline NLOPT_EXTERN(void) nlopt_srand_time(void) +{ + static void(*fun)(void) = NULL; + if (fun == NULL) fun = (void(*)(void)) R_GetCCallable("nloptr","nlopt_srand_time"); + return fun(); +} + +inline NLOPT_EXTERN(void) nlopt_version(int *major, int *minor, int *bugfix) +{ + static void(*fun)(int *, int *, int *) = NULL; + if (fun == NULL) fun = (void(*)(int *, int *, int *)) R_GetCCallable("nloptr","nlopt_version"); + return fun(major, minor, bugfix); +} + +inline NLOPT_EXTERN(nlopt_opt) nlopt_create(nlopt_algorithm algorithm, unsigned n) +{ + static nlopt_opt(*fun)(nlopt_algorithm, unsigned) = NULL; + if (fun == NULL) fun = (nlopt_opt(*)(nlopt_algorithm, unsigned)) R_GetCCallable("nloptr","nlopt_create"); + return fun(algorithm, n); +} + +inline NLOPT_EXTERN(void) nlopt_destroy(nlopt_opt opt) +{ + static void(*fun)(nlopt_opt) = NULL; + if (fun == NULL) fun = (void(*)(nlopt_opt)) R_GetCCallable("nloptr","nlopt_destroy"); + return fun(opt); +} + +inline NLOPT_EXTERN(nlopt_opt) nlopt_copy(const nlopt_opt opt) +{ + static nlopt_opt(*fun)(const nlopt_opt) = NULL; + if (fun == NULL) fun = (nlopt_opt(*)(const nlopt_opt)) R_GetCCallable("nloptr","nlopt_copy"); + return fun(opt); +} + +inline NLOPT_EXTERN(nlopt_result) nlopt_optimize(nlopt_opt opt, double *x, double *opt_f) +{ + static nlopt_result(*fun)(nlopt_opt, double *, double *) = NULL; + if (fun == NULL) fun = (nlopt_result(*)(nlopt_opt, double *, double *)) R_GetCCallable("nloptr","nlopt_optimize"); + return fun(opt, x, opt_f); +} + +inline NLOPT_EXTERN(nlopt_result) nlopt_set_min_objective(nlopt_opt opt, nlopt_func f, void *f_data) +{ + static nlopt_result(*fun)(nlopt_opt, nlopt_func, void *) = NULL; + if (fun == NULL) fun = (nlopt_result(*)(nlopt_opt, nlopt_func, void *)) R_GetCCallable("nloptr","nlopt_set_min_objective"); + return fun(opt, f, f_data); +} + +inline NLOPT_EXTERN(nlopt_result) nlopt_set_max_objective(nlopt_opt opt, nlopt_func f, void *f_data) +{ + static nlopt_result(*fun)(nlopt_opt, nlopt_func, void *) = NULL; + if (fun == NULL) fun = (nlopt_result(*)(nlopt_opt, nlopt_func, void *)) R_GetCCallable("nloptr","nlopt_set_max_objective"); + return fun(opt, f, f_data); +} + +inline NLOPT_EXTERN(nlopt_result) nlopt_set_precond_min_objective(nlopt_opt opt, nlopt_func f, nlopt_precond pre, void *f_data) +{ + static nlopt_result(*fun)(nlopt_opt, nlopt_func, nlopt_precond, void *) = NULL; + if (fun == NULL) fun = (nlopt_result(*)(nlopt_opt, nlopt_func, nlopt_precond, void *)) R_GetCCallable("nloptr","nlopt_set_precond_min_objective"); + return fun(opt, f, pre, f_data); +} + +inline NLOPT_EXTERN(nlopt_result) nlopt_set_precond_max_objective(nlopt_opt opt, nlopt_func f, nlopt_precond pre, void *f_data) +{ + static nlopt_result(*fun)(nlopt_opt, nlopt_func, nlopt_precond, void *) = NULL; + if (fun == NULL) fun = (nlopt_result(*)(nlopt_opt, nlopt_func, nlopt_precond, void *)) R_GetCCallable("nloptr","nlopt_set_precond_max_objective"); + return fun(opt, f, pre, f_data); +} + +inline NLOPT_EXTERN(nlopt_algorithm) nlopt_get_algorithm(const nlopt_opt opt) +{ + static nlopt_algorithm(*fun)(const nlopt_opt) = NULL; + if (fun == NULL) fun = (nlopt_algorithm(*)(const nlopt_opt)) R_GetCCallable("nloptr","nlopt_get_algorithm"); + return fun(opt); +} + +inline NLOPT_EXTERN(unsigned) nlopt_get_dimension(const nlopt_opt opt) +{ + static unsigned(*fun)(const nlopt_opt) = NULL; + if (fun == NULL) fun = (unsigned(*)(const nlopt_opt)) R_GetCCallable("nloptr","nlopt_get_dimension"); + return fun(opt); +} + +/* constraints: */ + +inline NLOPT_EXTERN(nlopt_result) nlopt_set_lower_bounds(nlopt_opt opt, const double *lb) +{ + static nlopt_result(*fun)(nlopt_opt, const double *) = NULL; + if (fun == NULL) fun = (nlopt_result(*)(nlopt_opt, const double *)) R_GetCCallable("nloptr","nlopt_set_lower_bounds"); + return fun(opt, lb); +} + +inline NLOPT_EXTERN(nlopt_result) nlopt_set_lower_bounds1(nlopt_opt opt, double lb) +{ + static nlopt_result(*fun)(nlopt_opt, double) = NULL; + if (fun == NULL) fun = (nlopt_result(*)(nlopt_opt, double)) R_GetCCallable("nloptr","nlopt_set_lower_bounds1"); + return fun(opt, lb); +} + +inline NLOPT_EXTERN(nlopt_result) nlopt_get_lower_bounds(const nlopt_opt opt, double *lb) +{ + static nlopt_result(*fun)(const nlopt_opt, double *) = NULL; + if (fun == NULL) fun = (nlopt_result(*)(const nlopt_opt, double *)) R_GetCCallable("nloptr","nlopt_get_lower_bounds"); + return fun(opt, lb); +} + +inline NLOPT_EXTERN(nlopt_result) nlopt_set_upper_bounds(nlopt_opt opt, const double *ub) +{ + static nlopt_result(*fun)(nlopt_opt, const double *) = NULL; + if (fun == NULL) fun = (nlopt_result(*)(nlopt_opt, const double *)) R_GetCCallable("nloptr","nlopt_set_upper_bounds"); + return fun(opt, ub); +} + +inline NLOPT_EXTERN(nlopt_result) nlopt_set_upper_bounds1(nlopt_opt opt, double ub) +{ + static nlopt_result(*fun)(nlopt_opt, double) = NULL; + if (fun == NULL) fun = (nlopt_result(*)(nlopt_opt, double)) R_GetCCallable("nloptr","nlopt_set_upper_bounds1"); + return fun(opt, ub); +} + +inline NLOPT_EXTERN(nlopt_result) nlopt_get_upper_bounds(const nlopt_opt opt, double *ub) +{ + static nlopt_result(*fun)(const nlopt_opt, double *) = NULL; + if (fun == NULL) fun = (nlopt_result(*)(const nlopt_opt, double *)) R_GetCCallable("nloptr","nlopt_get_upper_bounds"); + return fun(opt, ub); +} + +inline NLOPT_EXTERN(nlopt_result) nlopt_remove_inequality_constraints(nlopt_opt opt) +{ + static nlopt_result(*fun)(nlopt_opt) = NULL; + if (fun == NULL) fun = (nlopt_result(*)(nlopt_opt)) R_GetCCallable("nloptr","nlopt_remove_inequality_constraints"); + return fun(opt); +} + +inline NLOPT_EXTERN(nlopt_result) nlopt_add_inequality_constraint(nlopt_opt opt, + nlopt_func fc, + void *fc_data, + double tol) +{ + static nlopt_result(*fun)(nlopt_opt, nlopt_func, void *, double) = NULL; + if (fun == NULL) fun = (nlopt_result(*)(nlopt_opt, nlopt_func, void *, double)) R_GetCCallable("nloptr","nlopt_add_inequality_constraint"); + return fun(opt, fc, fc_data, tol); +} + +inline NLOPT_EXTERN(nlopt_result) nlopt_add_precond_inequality_constraint( + nlopt_opt opt, nlopt_func fc, nlopt_precond pre, void *fc_data, + double tol) +{ + static nlopt_result(*fun)(nlopt_opt, nlopt_func, nlopt_precond, void *, double) = NULL; + if (fun == NULL) fun = (nlopt_result(*)(nlopt_opt, nlopt_func, nlopt_precond, void *, double)) R_GetCCallable("nloptr","nlopt_add_precond_inequality_constraint"); + return fun(opt, fc, pre, fc_data, tol); +} + +inline NLOPT_EXTERN(nlopt_result) nlopt_add_inequality_mconstraint(nlopt_opt opt, + unsigned m, + nlopt_mfunc fc, + void *fc_data, + const double *tol) +{ + static nlopt_result(*fun)(nlopt_opt, unsigned, nlopt_mfunc, void *, const double *) = NULL; + if (fun == NULL) fun = (nlopt_result(*)(nlopt_opt, unsigned, nlopt_mfunc, void *, const double *)) R_GetCCallable("nloptr","nlopt_add_inequality_mconstraint"); + return fun(opt, m, fc, fc_data, tol); +} + +inline NLOPT_EXTERN(nlopt_result) nlopt_remove_equality_constraints(nlopt_opt opt) +{ + static nlopt_result(*fun)(nlopt_opt) = NULL; + if (fun == NULL) fun = (nlopt_result(*)(nlopt_opt)) R_GetCCallable("nloptr","nlopt_remove_equality_constraints"); + return fun(opt); +} + +inline NLOPT_EXTERN(nlopt_result) nlopt_add_equality_constraint(nlopt_opt opt, + nlopt_func h, + void *h_data, + double tol) +{ + static nlopt_result(*fun)(nlopt_opt, nlopt_func, void *, double) = NULL; + if (fun == NULL) fun = (nlopt_result(*)(nlopt_opt, nlopt_func, void *, double)) R_GetCCallable("nloptr","nlopt_add_equality_constraint"); + return fun(opt, h, h_data, tol); +} + +inline NLOPT_EXTERN(nlopt_result) nlopt_add_precond_equality_constraint( + nlopt_opt opt, nlopt_func h, nlopt_precond pre, void *h_data, + double tol) +{ + static nlopt_result(*fun)(nlopt_opt, nlopt_func, nlopt_precond, void *, double) = NULL; + if (fun == NULL) fun = (nlopt_result(*)(nlopt_opt, nlopt_func, nlopt_precond, void *, double)) R_GetCCallable("nloptr","nlopt_add_precond_equality_constraint"); + return fun(opt, h, pre, h_data, tol); +} + +inline NLOPT_EXTERN(nlopt_result) nlopt_add_equality_mconstraint(nlopt_opt opt, + unsigned m, + nlopt_mfunc h, + void *h_data, + const double *tol) +{ + static nlopt_result(*fun)(nlopt_opt, unsigned, nlopt_mfunc, void *, const double *) = NULL; + if (fun == NULL) fun = (nlopt_result(*)(nlopt_opt, unsigned, nlopt_mfunc, void *, const double *)) R_GetCCallable("nloptr","nlopt_add_equality_mconstraint"); + return fun(opt, m, h, h_data, tol); +} + +/* stopping criteria: */ + +inline NLOPT_EXTERN(nlopt_result) nlopt_set_stopval(nlopt_opt opt, double stopval) +{ + static nlopt_result(*fun)(nlopt_opt, double) = NULL; + if (fun == NULL) fun = (nlopt_result(*)(nlopt_opt, double)) R_GetCCallable("nloptr","nlopt_set_stopval"); + return fun(opt, stopval); +} + +inline NLOPT_EXTERN(double) nlopt_get_stopval(const nlopt_opt opt) +{ + static double(*fun)(const nlopt_opt) = NULL; + if (fun == NULL) fun = (double(*)(const nlopt_opt)) R_GetCCallable("nloptr","nlopt_get_stopval"); + return fun(opt); +} + +inline NLOPT_EXTERN(nlopt_result) nlopt_set_ftol_rel(nlopt_opt opt, double tol) +{ + static nlopt_result(*fun)(nlopt_opt, double) = NULL; + if (fun == NULL) fun = (nlopt_result(*)(nlopt_opt, double)) R_GetCCallable("nloptr","nlopt_set_ftol_rel"); + return fun(opt, tol); +} + +inline NLOPT_EXTERN(double) nlopt_get_ftol_rel(const nlopt_opt opt) +{ + static double(*fun)(const nlopt_opt) = NULL; + if (fun == NULL) fun = (double(*)(const nlopt_opt)) R_GetCCallable("nloptr","nlopt_get_ftol_rel"); + return fun(opt); +} + +inline NLOPT_EXTERN(nlopt_result) nlopt_set_ftol_abs(nlopt_opt opt, double tol) +{ + static nlopt_result(*fun)(nlopt_opt, double) = NULL; + if (fun == NULL) fun = (nlopt_result(*)(nlopt_opt, double)) R_GetCCallable("nloptr","nlopt_set_ftol_abs"); + return fun(opt, tol); +} + +inline NLOPT_EXTERN(double) nlopt_get_ftol_abs(const nlopt_opt opt) +{ + static double(*fun)(const nlopt_opt) = NULL; + if (fun == NULL) fun = (double(*)(const nlopt_opt)) R_GetCCallable("nloptr","nlopt_get_ftol_abs"); + return fun(opt); +} + +inline NLOPT_EXTERN(nlopt_result) nlopt_set_xtol_rel(nlopt_opt opt, double tol) +{ + static nlopt_result(*fun)(nlopt_opt, double) = NULL; + if (fun == NULL) fun = (nlopt_result(*)(nlopt_opt, double)) R_GetCCallable("nloptr","nlopt_set_xtol_rel"); + return fun(opt, tol); +} + +inline NLOPT_EXTERN(double) nlopt_get_xtol_rel(const nlopt_opt opt) +{ + static double(*fun)(const nlopt_opt) = NULL; + if (fun == NULL) fun = (double(*)(const nlopt_opt)) R_GetCCallable("nloptr","nlopt_get_xtol_rel"); + return fun(opt); +} + +inline NLOPT_EXTERN(nlopt_result) nlopt_set_xtol_abs1(nlopt_opt opt, double tol) +{ + static nlopt_result(*fun)(nlopt_opt, double) = NULL; + if (fun == NULL) fun = (nlopt_result(*)(nlopt_opt, double)) R_GetCCallable("nloptr","nlopt_set_xtol_abs1"); + return fun(opt, tol); +} + +inline NLOPT_EXTERN(nlopt_result) nlopt_set_xtol_abs(nlopt_opt opt, const double *tol) +{ + static nlopt_result(*fun)(nlopt_opt, const double *) = NULL; + if (fun == NULL) fun = (nlopt_result(*)(nlopt_opt, const double *)) R_GetCCallable("nloptr","nlopt_set_xtol_abs"); + return fun(opt, tol); +} + +inline NLOPT_EXTERN(nlopt_result) nlopt_get_xtol_abs(const nlopt_opt opt, double *tol) +{ + static nlopt_result(*fun)(nlopt_opt, double *) = NULL; + if (fun == NULL) fun = (nlopt_result(*)(nlopt_opt, double *)) R_GetCCallable("nloptr","nlopt_get_xtol_abs"); + return fun(opt, tol); +} + +inline NLOPT_EXTERN(nlopt_result) nlopt_set_maxeval(nlopt_opt opt, int maxeval) +{ + static nlopt_result(*fun)(nlopt_opt, int) = NULL; + if (fun == NULL) fun = (nlopt_result(*)(nlopt_opt, int)) R_GetCCallable("nloptr","nlopt_set_maxeval"); + return fun(opt, maxeval); +} + +inline NLOPT_EXTERN(int) nlopt_get_maxeval(const nlopt_opt opt) +{ + static int(*fun)(const nlopt_opt) = NULL; + if (fun == NULL) fun = (int(*)(const nlopt_opt)) R_GetCCallable("nloptr","nlopt_get_maxeval"); + return fun(opt); +} + +inline NLOPT_EXTERN(nlopt_result) nlopt_set_maxtime(nlopt_opt opt, double maxtime) +{ + static nlopt_result(*fun)(nlopt_opt, double) = NULL; + if (fun == NULL) fun = (nlopt_result(*)(nlopt_opt, double)) R_GetCCallable("nloptr","nlopt_set_maxtime"); + return fun(opt, maxtime); +} + +inline NLOPT_EXTERN(double) nlopt_get_maxtime(const nlopt_opt opt) +{ + static double(*fun)(nlopt_opt) = NULL; + if (fun == NULL) fun = (double(*)(nlopt_opt)) R_GetCCallable("nloptr","nlopt_get_maxtime"); + return fun(opt); +} + +inline NLOPT_EXTERN(nlopt_result) nlopt_force_stop(nlopt_opt opt) +{ + static nlopt_result(*fun)(nlopt_opt) = NULL; + if (fun == NULL) fun = (nlopt_result(*)(nlopt_opt)) R_GetCCallable("nloptr","nlopt_force_stop"); + return fun(opt); +} + +inline NLOPT_EXTERN(nlopt_result) nlopt_set_force_stop(nlopt_opt opt, int val) +{ + static nlopt_result(*fun)(nlopt_opt, int) = NULL; + if (fun == NULL) fun = (nlopt_result(*)(nlopt_opt, int)) R_GetCCallable("nloptr","nlopt_set_force_stop"); + return fun(opt, val); +} + +inline NLOPT_EXTERN(int) nlopt_get_force_stop(const nlopt_opt opt) +{ + static int(*fun)(const nlopt_opt) = NULL; + if (fun == NULL) fun = (int(*)(const nlopt_opt)) R_GetCCallable("nloptr","nlopt_get_force_stop"); + return fun(opt); +} + +/* more algorithm-specific parameters */ + +inline NLOPT_EXTERN(nlopt_result) nlopt_set_local_optimizer(nlopt_opt opt, const nlopt_opt local_opt) +{ + static nlopt_result(*fun)(nlopt_opt, const nlopt_opt) = NULL; + if (fun == NULL) fun = (nlopt_result(*)(nlopt_opt, const nlopt_opt)) R_GetCCallable("nloptr","nlopt_set_local_optimizer"); + return fun(opt, local_opt); +} + +inline NLOPT_EXTERN(nlopt_result) nlopt_set_population(nlopt_opt opt, unsigned pop) +{ + static nlopt_result(*fun)(nlopt_opt, unsigned) = NULL; + if (fun == NULL) fun = (nlopt_result(*)(nlopt_opt, unsigned)) R_GetCCallable("nloptr","nlopt_set_population"); + return fun(opt, pop); +} + +inline NLOPT_EXTERN(unsigned) nlopt_get_population(const nlopt_opt opt) +{ + static unsigned(*fun)(const nlopt_opt) = NULL; + if (fun == NULL) fun = (unsigned(*)(const nlopt_opt)) R_GetCCallable("nloptr","nlopt_get_population"); + return fun(opt); +} + +inline NLOPT_EXTERN(nlopt_result) nlopt_set_vector_storage(nlopt_opt opt, unsigned dim) +{ + static nlopt_result(*fun)(nlopt_opt, unsigned) = NULL; + if (fun == NULL) fun = (nlopt_result(*)(nlopt_opt, unsigned)) R_GetCCallable("nloptr","nlopt_set_vector_storage"); + return fun(opt, dim); +} + +inline NLOPT_EXTERN(unsigned) nlopt_get_vector_storage(const nlopt_opt opt) +{ + static unsigned(*fun)(const nlopt_opt) = NULL; + if (fun == NULL) fun = (unsigned(*)(const nlopt_opt)) R_GetCCallable("nloptr","nlopt_get_vector_storage"); + return fun(opt); +} + +inline NLOPT_EXTERN(nlopt_result) nlopt_set_default_initial_step(nlopt_opt opt, const double *x) +{ + static nlopt_result(*fun)(nlopt_opt, const double *) = NULL; + if (fun == NULL) fun = (nlopt_result(*)(nlopt_opt, const double *)) R_GetCCallable("nloptr","nlopt_set_default_initial_step"); + return fun(opt, x); +} + +inline NLOPT_EXTERN(nlopt_result) nlopt_set_initial_step(nlopt_opt opt, const double *dx) +{ + static nlopt_result(*fun)(nlopt_opt, const double *) = NULL; + if (fun == NULL) fun = (nlopt_result(*)(nlopt_opt, const double *)) R_GetCCallable("nloptr","nlopt_set_initial_step"); + return fun(opt, dx); +} + +inline NLOPT_EXTERN(nlopt_result) nlopt_set_initial_step1(nlopt_opt opt, double dx) +{ + static nlopt_result(*fun)(nlopt_opt, double) = NULL; + if (fun == NULL) fun = (nlopt_result(*)(nlopt_opt, double)) R_GetCCallable("nloptr","nlopt_set_initial_step1"); + return fun(opt, dx); +} + +inline NLOPT_EXTERN(nlopt_result) nlopt_get_initial_step(const nlopt_opt opt, const double *x, double *dx) +{ + static nlopt_result(*fun)(const nlopt_opt, const double *, double *) = NULL; + if (fun == NULL) fun = (nlopt_result(*)(const nlopt_opt, const double *, double *)) R_GetCCallable("nloptr","nlopt_get_initial_step"); + return fun(opt, x, dx); +} + +#endif /* __NLOPTRAPI_H__ */ diff --git a/man/MAdensity_plot.Rd b/man/MAdensity_plot.Rd index 9373463..7decf60 100644 --- a/man/MAdensity_plot.Rd +++ b/man/MAdensity_plot.Rd @@ -4,7 +4,7 @@ \alias{MAdensity_plot} \title{MAdensity_plot - Create a density plot from a model averaged model.} \usage{ -MAdensity_plot(A, ...) +MAdensity_plot(A) } \arguments{ \item{A}{the model averaged model to plot} @@ -13,10 +13,13 @@ MAdensity_plot(A, ...) Create a density plot from a model averaged model fit with MCMC. } \examples{ - -... -model <- ma_continuous_fit(doses,y,model_list=model_list, +\dontrun{ +doses <- cbind(c(0,25,50,100,200)) +y <- cbind(c(6,5.2,2.4,1.1,0.75), + c(20,20,19,20,20), + c(1.2,1.1,0.81,0.74,0.66)) +model <- ma_continuous_fit(doses,y, fit_type = "mcmc",BMD_TYPE = 'sd',BMR = 1) MAdensity_plot(model) - +} } diff --git a/man/NTP.Rd b/man/NTP.Rd deleted file mode 100644 index 5b33899..0000000 --- a/man/NTP.Rd +++ /dev/null @@ -1,26 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/NTP.R -\docType{data} -\name{NTP} -\alias{NTP} -\title{Williams Trend test for} -\format{ -An object of class \code{module} (inherits from \code{list}) of length 6. -} -\usage{ -NTP -} -\arguments{ -\item{data}{A data frame with column names in the formula.} -} -\value{ -The results of a Williams trend test for each level in \code{dose_name}. -} -\description{ -Williams Trend test for -} -\examples{ -add(1, 1) -add(10, 1) -} -\keyword{datasets} diff --git a/man/cleveland_plot.Rd b/man/cleveland_plot.Rd index d72d8d1..55859a4 100644 --- a/man/cleveland_plot.Rd +++ b/man/cleveland_plot.Rd @@ -4,7 +4,7 @@ \alias{cleveland_plot} \title{cleveland_plot - Create a Cleveland plot from a model averaged model.} \usage{ -cleveland_plot(A, ...) +cleveland_plot(A) } \arguments{ \item{A}{the model averaged model to plot} @@ -13,9 +13,8 @@ cleveland_plot(A, ...) Create a Cleveland plot from a model averaged model. } \examples{ - -... +\dontrun{ model = ma_dichotomous_fit(D,Y,N) cleveland_plot(model) - +} } diff --git a/man/create_continuous_prior.Rd b/man/create_continuous_prior.Rd new file mode 100644 index 0000000..b817a80 --- /dev/null +++ b/man/create_continuous_prior.Rd @@ -0,0 +1,35 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/Build_Priors.R +\name{create_continuous_prior} +\alias{create_continuous_prior} +\title{create_continuous_prior Given priorlist, a model, + and a distribution. Create a prior for a given analysis.} +\usage{ +create_continuous_prior(prior_list, model, distribution, deg = 2) +} +\arguments{ +\item{prior_list}{First Prior} + +\item{model}{Model to be used} + +\item{distribution}{- Normal "normal", Normal non-constant variance "normal-ncv", or +log-normal "lognormal"} + +\item{deg}{- For polynomial models only, the degree of the polynomial.} +} +\value{ +new BMDprior list. +} +\description{ +create_continuous_prior Given priorlist, a model, + and a distribution. Create a prior for a given analysis. +} +\examples{ +plist<- create_prior_list(normprior(0,0.1,-100,100), # a + normprior(0,1, -1e2,1e2), # b + lnormprior(1,0.2,0,18), #k + normprior(0,1,-18,18)) + + power_normal <- create_continuous_prior(plist,"power","normal") + +} diff --git a/man/create_dichotomous_prior.Rd b/man/create_dichotomous_prior.Rd new file mode 100644 index 0000000..4f21f89 --- /dev/null +++ b/man/create_dichotomous_prior.Rd @@ -0,0 +1,28 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/Build_Priors.R +\name{create_dichotomous_prior} +\alias{create_dichotomous_prior} +\title{create_dichotomous_prior Given priorlist, a model, + and a distribution. Create a prior for a given analysis.} +\usage{ +create_dichotomous_prior(prior, model) +} +\arguments{ +\item{prior}{First Prior} + +\item{model}{Model to be used should be one of"hill","gamma","logistic","log-logistic","log-probit","multistage", "probit", "qlinear", or "weibull"} +} +\value{ +new BMDprior list that can be used in a dichotomous fit. +} +\description{ +create_dichotomous_prior Given priorlist, a model, + and a distribution. Create a prior for a given analysis. +} +\examples{ +plist<- create_prior_list(normprior(0,0.1,-100,100), # a + lnormprior(1,0.2,0,18)) + + power_normal <- create_dichotomous_prior(plist,"logistic") + +} diff --git a/man/create_prior_list.Rd b/man/create_prior_list.Rd new file mode 100644 index 0000000..2a03971 --- /dev/null +++ b/man/create_prior_list.Rd @@ -0,0 +1,32 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/prior_classes.R +\name{create_prior_list} +\alias{create_prior_list} +\title{create_prior_lists .. Given priors + created using the ToxicR prior functions, create a list of priors + for a model.} +\usage{ +create_prior_list(x1, x2, ...) +} +\arguments{ +\item{x1}{First Prior} + +\item{x2}{Second Prior} + +\item{...}{Aditional arguments} +} +\value{ +new BMDprior list. +} +\description{ +create_prior_lists .. Given priors + created using the ToxicR prior functions, create a list of priors + for a model. +} +\examples{ +plist<- create_prior_list(normprior(0,0.1,-100,100), # a + normprior(0,1, -1e2,1e2), # b + lnormprior(1,0.2,0,18), #k + normprior(0,1,-18,18)) + +} diff --git a/man/dichotomousDR.Rd b/man/dichotomousDR.Rd new file mode 100644 index 0000000..d1a68c5 --- /dev/null +++ b/man/dichotomousDR.Rd @@ -0,0 +1,31 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/NTP.R +\docType{data} +\name{dichotomousDR} +\alias{dichotomousDR} +\title{733 unique dose-response datasets} +\format{ +A data frame with 2727 rows and 11 variables: +\describe{ + \item{ID}{-The study ID in the database.} + \item{chemical}{-Name of the Chemical in the study.} + \item{data.source}{-Source of the risk assessment data.} + \item{CASRN}{-Chemical's CASRN} + \item{dose}{-Dose spacing of the study using the original study.} + \item{r.dose}{-Doses of the experiment relative to 1 being the maximum dose tested.} + \item{n}{-Number of animals on test.} + \item{obs}{-Number of adverse events.} + \item{organ}{-Organ impacted.} + \item{effect}{-Type of adverse effect.} + \item{study.source}{-Publication related to the experiment.} +} +More information at: \doi{10.1111/risa.13218} +} +\usage{ +dichotomousDR +} +\description{ +A dataset containing 733 dichotomous dose-response studies that were involved in +regulatory risk assessment. +} +\keyword{datasets} diff --git a/man/lnormprior.Rd b/man/lnormprior.Rd new file mode 100644 index 0000000..c6f00d3 --- /dev/null +++ b/man/lnormprior.Rd @@ -0,0 +1,33 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/prior_classes.R +\name{lnormprior} +\alias{lnormprior} +\title{lnormprior - create a lognormal prior.} +\usage{ +lnormprior(mean = 0, sd = 1, lb = -100, ub = 100) +} +\arguments{ +\item{mean}{log-mean of the prior distribution.} + +\item{sd}{log-sd of the prior distribution.} + +\item{lb}{lower bound on the distribution. Necessary for the optimization algorithms, +To make sure it is a fully normal prior, make lb small relative to the mean/sd.} + +\item{ub}{Upper bound on the distribution. Necessary for the optimization algorithms, +To make sure it is a fully normal prior, make ub large relative to the mean/sd.} +} +\value{ +a normal prior model object +} +\description{ +Specify a log-normal prior for a ToxicR Bayesian model fit. +} +\examples{ + # Log-Normal Prior with mean 0,sd-1 + lnormprior(mean = 0, sd = 1, lb = -1e4, ub=1e4) + + # Truncated Log-Normal prior, Truncated below at 1 + lnormprior(mean = 0, sd = 1, lb = 1, ub=1e4) + +} diff --git a/man/ma_continuous_fit.Rd b/man/ma_continuous_fit.Rd index 98e0f6a..1ea9078 100644 --- a/man/ma_continuous_fit.Rd +++ b/man/ma_continuous_fit.Rd @@ -32,13 +32,15 @@ ma_continuous_fit( - Hybrid deviation can be specified with 'BMR_TYPE = "hybrid"'. This defines the BMD that changes the probability of an adverse event by a stated amount relitive to no exposure (i.e 0). That is, it is the dose, BMD, that solves \eqn{\frac{Pr(X > x| dose) - Pr(X >x|0)}{Pr(X < x|0)} = BMR}. For this definition, \eqn{Pr(X < x|0) = 1 - Pr(X > X|0) = \pi_0}, where \eqn{0 \leq \pi_0 < 1} is defined by the user as "point_p," and it defaults to 0.01. Note: this discussion assumed increasing data. The fitter determines the direction of the data and inverts the probability statements for decreasing data. \cr - Absolute deviation can be specified with 'BMR_TYPE="abs"'. This defines the BMD as an absolute change from the control dose of zero by a specified amount. That is the BMD is the dose that solves the equation \eqn{\mid f(dose) - f(0) \mid = BMR}} +\item{BMR}{This option specifies the benchmark response BMR. The BMR is defined in relation to the BMD calculation requested (see BMD). By default, the "BMR = 0.1."} + \item{point_p}{This option is only used for hybrid BMD calculations. It defines a probability that is the cutpoint for observations. It is the probability that observations have this probability, or less, of being observed at the background dose.} +\item{alpha}{Alpha is the specified nominal coverage rate for computation of the lower bound on the BMDL and BMDU, i.e., one computes a \eqn{100\times(1-\alpha)\%} confidence interval. For the interval (BMDL,BMDU) this is a \eqn{100\times(1-2\alpha)\% }. By default, it is set to 0.05.} + \item{samples}{the number of samples to take (MCMC only)} \item{burnin}{the number of burnin samples to take (MCMC only)} - -\item{BRM}{This option specifies the benchmark response BMR. The BMR is defined in relation to the BMD calculation requested (see BMD). By default, the "BMR = 0.1."} } \value{ a model object containing a list of single models @@ -47,6 +49,7 @@ a model object containing a list of single models Fit a model averaged continuous BMD model. } \examples{ +\dontrun{ Hill.p <- rbind(c(481,-250.3,70,3.3), c(481,-250.3,40,1.3), c(481,-250.2,15,1.1), @@ -57,9 +60,8 @@ Hill.p <- rbind(c(481,-250.3,70,3.3), c(10.58,9.7,50,4)) hill <- data.frame(a=Hill.p[,1],b=Hill.p[,2],c=Hill.p[,3],d=Hill.p[,4]) doses <- rep(c(0,6.25,12.5,25,50,100),each=10) -dosesq <- rep(c(0,6.25,12.5,25,50,100),each=30) -mean <- cont_hill_f(as.numeric(hill[2,]),doses) -y <- rinvgauss(length(mean),mean,18528.14) +mean <- ToxicR:::.cont_hill_f(as.numeric(hill[2,]),doses) +y <- rnorm(length(mean),mean,20.14) model <- ma_continuous_fit(doses, y, fit_type = "laplace", BMD_TYPE = 'sd', BMR = 1) - +} } diff --git a/man/ma_dichotomous_fit.Rd b/man/ma_dichotomous_fit.Rd index 64fbe0b..99496f6 100644 --- a/man/ma_dichotomous_fit.Rd +++ b/man/ma_dichotomous_fit.Rd @@ -35,13 +35,15 @@ ma_dichotomous_fit( - Hybrid deviation can be specified with 'BMR_TYPE = "hybrid"'. This defines the BMD that changes the probability of an adverse event by a stated amount relitive to no exposure (i.e 0). That is, it is the dose, BMD, that solves \eqn{\frac{Pr(X > x| dose) - Pr(X >x|0)}{Pr(X < x|0)} = BMR}. For this definition, \eqn{Pr(X < x|0) = 1 - Pr(X > X|0) = \pi_0}, where \eqn{0 \leq \pi_0 < 1} is defined by the user as "point_p," and it defaults to 0.01. Note: this discussion assumed increasing data. The fitter determines the direction of the data and inverts the probability statements for decreasing data. \cr - Absolute deviation can be specified with 'BMR_TYPE="abs"'. This defines the BMD as an absolute change from the control dose of zero by a specified amount. That is the BMD is the dose that solves the equation \eqn{\mid f(dose) - f(0) \mid = BMR}} +\item{BMR}{This option specifies the benchmark response BMR. The BMR is defined in relation to the BMD calculation requested (see BMD). By default, the "BMR = 0.1."} + \item{point_p}{This option is only used for hybrid BMD calculations. It defines a probability that is the cutpoint for observations. It is the probability that observations have this probability, or less, of being observed at the background dose.} +\item{alpha}{Alpha is the specified nominal coverage rate for computation of the lower bound on the BMDL and BMDU, i.e., one computes a \eqn{100\times(1-\alpha)\% }. For the interval (BMDL,BMDU) this is a \eqn{100\times(1-2\alpha)\% }. By default, it is set to 0.05.} + \item{samples}{the number of samples to take (MCMC only)} \item{burnin}{the number of burnin samples to take (MCMC only)} - -\item{BRM}{This option specifies the benchmark response BMR. The BMR is defined in relation to the BMD calculation requested (see BMD). By default, the "BMR = 0.1."} } \value{ a model object containing a list of single models @@ -50,16 +52,16 @@ a model object containing a list of single models Fit a model averaged dichotomous BMD model. } \examples{ - +\dontrun{ mData <- matrix(c(0, 2,50, 1, 2,50, 3, 10, 50, 16, 18,50, 32, 18,50, - 33, 17,50),nrow=6,ncol=3,byrow=T) + 33, 17,50),nrow=6,ncol=3,byrow=TRUE) D <- mData[,1] Y <- mData[,2] N <- mData[,3] model = ma_dichotomous_fit(D,Y,N) - +} } diff --git a/man/normprior.Rd b/man/normprior.Rd new file mode 100644 index 0000000..d350555 --- /dev/null +++ b/man/normprior.Rd @@ -0,0 +1,33 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/prior_classes.R +\name{normprior} +\alias{normprior} +\title{normprior - create a normal prior object} +\usage{ +normprior(mean = 0, sd = 1, lb = -100, ub = 100) +} +\arguments{ +\item{mean}{mean of the prior} + +\item{sd}{sd of the prior distribution.} + +\item{lb}{lower bound on the distribution. Necessary for the optimization algorithms, +To make sure it is a fully normal prior, make lb small relative to the mean/sd.} + +\item{ub}{Upper bound on the distribution. Necessary for the optimization algorithms, +To make sure it is a fully normal prior, make ub large relative to the mean/sd.} +} +\value{ +a normal prior model object +} +\description{ +Specify a normal prior for a ToxicR Bayesian model fit. +} +\examples{ + # Normal Prior with mean 0,sd-1 + normprior(mean = 0, sd = 1, lb = -1e4, ub=1e4) + + # Truncated Normal prior, Truncated below at 0 + normprior(mean = 0, sd = 1, lb = 0, ub=1e4) + +} diff --git a/man/ntp_599_female.Rd b/man/ntp_599_female.Rd new file mode 100644 index 0000000..c36b1fc --- /dev/null +++ b/man/ntp_599_female.Rd @@ -0,0 +1,24 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/NTP.R +\docType{data} +\name{ntp_599_female} +\alias{ntp_599_female} +\title{Long term Thyroid Adenoma data from NTP Report 599} +\format{ +A data frame with 200 rows and 4 variables: +\describe{ + \item{treatment}{-The dose group for the observation.} + \item{days_on_study}{-Number of days on the study 730 is the max.} + \item{adenoma}{- Thyroid Adenoma (Yes/No) (1/0).} + \item{dose}{-The dose in mg/L} +} +For more information see: \doi{10.22427/NTP-DATA-TR-599} +} +\usage{ +ntp_599_female +} +\description{ +This dataset contains Thyroid Adenoma data for +female rats for the technical report TR-599: Sodium Tungstate Dihydrate. +} +\keyword{datasets} diff --git a/man/ntp_599_hemotology.Rd b/man/ntp_599_hemotology.Rd new file mode 100644 index 0000000..b66b7b2 --- /dev/null +++ b/man/ntp_599_hemotology.Rd @@ -0,0 +1,24 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/NTP.R +\docType{data} +\name{ntp_599_hemotology} +\alias{ntp_599_hemotology} +\title{Clinical Chemistry data from NTP Report 599} +\format{ +A data frame with 200 rows and 4 variables: +\describe{ + \item{concentration}{-The dose group for the observation.} + \item{sex}{- Male/Female.} + \item{response}{- Response variable} + \item{response_type}{- The type of response measured} +} +For more information see: \doi{10.22427/NTP-DATA-TR-599} +} +\usage{ +ntp_599_hemotology +} +\description{ +This dataset contains clinical chemistry data for +all rats in the short term 90-day study. +} +\keyword{datasets} diff --git a/man/ntp_dunn.Rd b/man/ntp_dunn.Rd new file mode 100644 index 0000000..af02167 --- /dev/null +++ b/man/ntp_dunn.Rd @@ -0,0 +1,31 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/NTP.R +\name{ntp_dunn} +\alias{ntp_dunn} +\title{ntp_dunn Dunn's test} +\usage{ +ntp_dunn(formula, data, dose_name = "dose") +} +\arguments{ +\item{formula}{An equation of the form \eqn{Y \sim X.} Here the variable +\eqn{Y} is the response of interest, and \eqn{X} represents discrete experimental +conditions. For example, if weight is the dependent variable, and you are +interested in looking at the trend across sex one would have 'weight ~ sex'.} + +\item{data}{A data frame with column names in the formula.} + +\item{dose_name}{The name of the variable containing the doses in the data frame \eqn{data}. +It is expected multiple doses for each of the experimental conditions \eqn{X}.} +} +\value{ +The results of a Dunn's test for each level in \eqn{dose_name}. +} +\description{ +ntp_dunn Dunn's test +} +\examples{ + +a = ntp_dunn(response ~ sex + response_type,data=ntp_599_hemotology, + dose_name="concentration") +summary(a) +} diff --git a/man/ntp_dunnett.Rd b/man/ntp_dunnett.Rd new file mode 100644 index 0000000..51e0b77 --- /dev/null +++ b/man/ntp_dunnett.Rd @@ -0,0 +1,29 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/NTP.R +\name{ntp_dunnett} +\alias{ntp_dunnett} +\title{ntp_dunett Dunnett's test} +\usage{ +ntp_dunnett(formula, data, dose_name = "dose") +} +\arguments{ +\item{formula}{An equation of the form \eqn{Y \sim X.} Here the variable +\eqn{Y} is the response of interest, and \eqn{X} represents discrete experimental +conditions. For example, if weight is the dependent variable, and you are +interested in looking at the trend across sex one would have 'weight ~ sex'.} + +\item{data}{A data frame with column names in the formula.} + +\item{dose_name}{The name of the variable containing the doses in the data frame \eqn{data}. +It is expected multiple doses for each of the experimental conditions \eqn{X}.} +} +\value{ +The results of Dunnet's test for each level in \eqn{dose_name} +} +\description{ +ntp_dunett Dunnett's test +} +\examples{ +a = ntp_dunnett(response ~ sex + response_type,data=ntp_599_hemotology,dose_name="concentration") +summary(a) +} diff --git a/man/ntp_jonckeere.Rd b/man/ntp_jonckeere.Rd new file mode 100644 index 0000000..0cb90b8 --- /dev/null +++ b/man/ntp_jonckeere.Rd @@ -0,0 +1,34 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/NTP.R +\name{ntp_jonckeere} +\alias{ntp_jonckeere} +\title{ntp_jonckeere +Jonckherre's test for significant differences from background dose} +\usage{ +ntp_jonckeere(formula, data, dose_name = "dose", pair = "Williams") +} +\arguments{ +\item{formula}{An equation of the form \eqn{Y \sim X.} Here the variable +\eqn{Y} is the response of interest, and \eqn{X} represents discrete experimental +conditions. For example, if weight is the dependent variable, and you are +interested in looking at the trend across sex one would have 'weight ~ sex'.} + +\item{data}{A data frame with column names in the formula.} + +\item{dose_name}{The name of the variable containing the doses in the data frame \eqn{data}. +It is expected multiple doses for each of the experimental conditions \eqn{X}.} + +\item{pair}{The type of test used for pairwise comparison. It can either be +"Williams" or "Shirley"} +} +\value{ +The results of a global test for difference from background. +} +\description{ +ntp_jonckeere +Jonckherre's test for significant differences from background dose +} +\examples{ + +ntp_jonckeere(response ~ sex + response_type,data=ntp_599_hemotology,dose_name="concentration") +} diff --git a/man/ntp_polyk.Rd b/man/ntp_polyk.Rd new file mode 100644 index 0000000..5e3df46 --- /dev/null +++ b/man/ntp_polyk.Rd @@ -0,0 +1,31 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/NTP.R +\name{ntp_polyk} +\alias{ntp_polyk} +\title{Poly-k trend test +This function implements the NTP's polyK trend test.} +\usage{ +ntp_polyk(dose, tumor, daysOnStudy) +} +\arguments{ +\item{dose}{An equation of the form \eqn{Y \sim X.} Here the variable +\eqn{Y} is the response of interest, and \eqn{X} represents discrete experimental +conditions. For example, if weight is the dependent variable, and you are +interested in looking at the trend across sex one would have 'weight ~ sex'.} + +\item{tumor}{A data frame with column names in the formula.} + +\item{daysOnStudy}{The name of the variable containing the doses in the data frame \eqn{data}. +It is expected multiple doses for each of the experimental conditions \eqn{X}.} +} +\value{ +The results of a Williams trend test for each level in dose_name. +More information on this procedure at: \doi{10.2307/2531856} and \doi{10.2307/2532200} +} +\description{ +Poly-k trend test +This function implements the NTP's polyK trend test. +} +\examples{ +ntp_polyk(ntp_599_female$dose,ntp_599_female$adenoma,ntp_599_female$days_on_study) +} diff --git a/man/ntp_shirley.Rd b/man/ntp_shirley.Rd new file mode 100644 index 0000000..b710b5f --- /dev/null +++ b/man/ntp_shirley.Rd @@ -0,0 +1,30 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/NTP.R +\name{ntp_shirley} +\alias{ntp_shirley} +\title{ntp_shirley Shirley's test as programmed at the NTP} +\usage{ +ntp_shirley(formula, data, dose_name = "dose") +} +\arguments{ +\item{formula}{An equation of the form \eqn{Y \sim X.} Here the variable +\eqn{Y} is the response of interest, and \eqn{X} represents discrete experimental +conditions. For example, if weight is the dependent variable, and you are +interested in looking at the trend across sex one would have 'weight ~ sex'.} + +\item{data}{A data frame with column names in the formula.} + +\item{dose_name}{The name of the variable containing the doses in the data frame \eqn{data}. +It is expected multiple doses for each of the experimental conditions \eqn{X}.} +} +\value{ +The results of a non-parametric Shirley's isotone test for trend on +each level in \eqn{dose_name}. For more information see: \doi{10.2307/2529789} +} +\description{ +ntp_shirley Shirley's test as programmed at the NTP +} +\examples{ +a = ntp_shirley(weight ~ sex, data=ntp_weight_data) +summary(a) +} diff --git a/man/ntp_weight_data.Rd b/man/ntp_weight_data.Rd new file mode 100644 index 0000000..10d551b --- /dev/null +++ b/man/ntp_weight_data.Rd @@ -0,0 +1,24 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/NTP.R +\docType{data} +\name{ntp_weight_data} +\alias{ntp_weight_data} +\title{Short term terminal body-weight data from NTP Report 599} +\format{ +A data frame with 120 rows and 4 variables: +\describe{ + \item{Dose_Group}{-The dose group for the observation.} + \item{dose}{-The dose in mg/L } + \item{sex}{-Animal's Sex} + \item{weight}{-Terminal body-weight} +} +For more information see: \doi{10.22427/NTP-DATA-TR-599} +} +\usage{ +ntp_weight_data +} +\description{ +This dataset contains terminal body-weight data for male and +female rats for the technical report TR-599: Sodium Tungstate Dihydrate. +} +\keyword{datasets} diff --git a/man/ntp_williams.Rd b/man/ntp_williams.Rd new file mode 100644 index 0000000..fb3c73a --- /dev/null +++ b/man/ntp_williams.Rd @@ -0,0 +1,31 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/NTP.R +\name{ntp_williams} +\alias{ntp_williams} +\title{Wiliam's trend test} +\usage{ +ntp_williams(formula, data, dose_name = "dose") +} +\arguments{ +\item{formula}{An equation of the form \eqn{Y \sim X.} Here the variable +\eqn{Y} is the response of interest, and \eqn{X} represents discrete experimental +conditions. For example, if weight is the dependent variable, and you are +interested in looking at the trend across sex one would have 'weight ~ sex'.} + +\item{data}{A data frame with column names in the formula.} + +\item{dose_name}{The name of the variable containing the doses in the data frame \eqn{data}. +It is expected multiple doses for each of the experimental conditions \eqn{X}.} +} +\value{ +The results of a Williams trend test for each level in \eqn{dose_name}. +For more information on the Williams trend test: \doi{10.2307/2528930} +} +\description{ +Williams Trend test for +} +\examples{ + +a = ntp_williams(weight ~ sex, data=ntp_weight_data) +summary(a) +} diff --git a/man/single_continuous_fit.Rd b/man/single_continuous_fit.Rd index 1d19cbe..ecb5134 100644 --- a/man/single_continuous_fit.Rd +++ b/man/single_continuous_fit.Rd @@ -27,15 +27,25 @@ single_continuous_fit( \item{Y}{response matrix} +\item{model_type}{Mean model.} + \item{fit_type}{the method used to fit (laplace, mle, or mcmc)} +\item{prior}{Prior / model for the continuous fit. If this is specified, it overrides the parameters 'model_type' and 'distribution.'} + \item{BMD_TYPE}{BMD_TYPE specifies the type of benchmark dose analysis to be performed. For continuous models, there are four types of BMD definitions that are commonly used. \cr - Standard deviation is the default option, but it can be explicitly specified with 'BMR_TYPE = "sd"' This definition defines the BMD as the dose associated with the mean/median changing a specified number of standard deviations from the mean at the control dose., i.e., it is the dose, BMD, that solves \eqn{\mid f(dose)-f(0) \mid = BMR \times \sigma} \cr - Relative deviation can be specified with 'BMR_TYPE = "rel"'. This defines the BMD as the dose that changes the control mean/median a certain percentage from the background dose, i.e. it is the dose, BMD that solves \eqn{\mid f(dose) - f(0) \mid = (1 \pm BMR) f(0)} \cr - Hybrid deviation can be specified with 'BMR_TYPE = "hybrid"'. This defines the BMD that changes the probability of an adverse event by a stated amount relitive to no exposure (i.e 0). That is, it is the dose, BMD, that solves \eqn{\frac{Pr(X > x| dose) - Pr(X >x|0)}{Pr(X < x|0)} = BMR}. For this definition, \eqn{Pr(X < x|0) = 1 - Pr(X > X|0) = \pi_0}, where \eqn{0 \leq \pi_0 < 1} is defined by the user as "point_p," and it defaults to 0.01. Note: this discussion assumed increasing data. The fitter determines the direction of the data and inverts the probability statements for decreasing data. \cr -- Absolute deviation can be specified with 'BMR_TYPE="abs"'. This defines the BMD as an absolute change from the control dose of zero by a specified amount. That is the BMD is the dose that solves the equation \eqn{\mid f(dose) - f(0) \mid = BMR}} +- Absolute deviation can be specified with 'BMR_TYPE="abs"'. This defines the BMD as an absolute change from the control dose of zero by a specified amount. That is the BMD is the dose that solves the equation \eqn{\mid f(dose) - f(0) \mid = BMR}.} + +\item{BMR}{This option specifies the benchmark response BMR. The BMR is defined in relation to the BMD calculation requested (see BMD). By default, the "BMR = 0.1."\cr} -\item{point_p}{This option is only used for hybrid BMD calculations. It defines a probability that is the cutpoint for observations. It is the probability that observations have this probability, or less, of being observed at the background dose.} +\item{point_p}{This option is only used for hybrid BMD calculations. It defines a probability that is the cutpoint for observations. It is the probability that observations have this probability, or less, of being observed at the background dose. \cr} + +\item{distribution}{The underlying distribution used as the data distribution.} + +\item{alpha}{Alpha is the specified nominal coverage rate for computation of the lower bound on the BMDL and BMDU, i.e., one computes a \eqn{100\times(1-\alpha)\%} confidence interval. For the interval (BMDL,BMDU) this is a \eqn{100\times(1-2\alpha)\%} confidence interval. By default, it is set to 0.05.} \item{samples}{the number of samples to take (MCMC only)} @@ -46,8 +56,6 @@ single_continuous_fit( \item{ewald}{perform Wald CI computation instead of the default profile likelihood computation. This is the the 'FAST BMD' method of Ewald et al (2021)} \item{transform}{Transforms doses using \eqn{\log(dose+\sqrt{dose^2+1})}. Note: this is a log transform that has a derivative defined when dose =0.} - -\item{BRM}{This option specifies the benchmark response BMR. The BMR is defined in relation to the BMD calculation requested (see BMD). By default, the "BMR = 0.1."} } \value{ a model object @@ -62,7 +70,7 @@ M2[,1] <- c(0,25,50,100,200) M2[,2] <- c(6,5.2,2.4,1.1,0.75) M2[,3] <- c(20,20,19,20,20) M2[,4] <- c(1.2,1.1,0.81,0.74,0.66) -model = single_continuous_fit(M2[,1,drop=F], M2[,2:4], BMD_TYPE="sd", BMR=1, ewald = T, +model = single_continuous_fit(M2[,1,drop=FALSE], M2[,2:4], BMD_TYPE="sd", BMR=1, ewald = TRUE, distribution = "normal",fit_type="laplace",model_type = "hill") } diff --git a/man/single_dichotomous_fit.Rd b/man/single_dichotomous_fit.Rd index 01d1f4c..7497e7a 100644 --- a/man/single_dichotomous_fit.Rd +++ b/man/single_dichotomous_fit.Rd @@ -10,7 +10,7 @@ single_dichotomous_fit( N, model_type, fit_type = "laplace", - prior = "default", + prior = NULL, BMR = 0.1, alpha = 0.05, degree = 2, @@ -25,15 +25,22 @@ single_dichotomous_fit( \item{N}{A numeric vector or matrix of the number of replicates at a dose.} +\item{model_type}{The mean model for the dichotomous model fit. It can be one of the following: \cr +"hill","gamma","logistic", "log-logistic", "log-probit" ,"multistage" ,"probit","qlinear","weibull"} + \item{fit_type}{the method used to fit (laplace, mle, or mcmc)} +\item{prior}{Used if you want to specify a prior for the data.} + +\item{BMR}{This option specifies the benchmark response BMR. The BMR is defined in relation to the BMD calculation requested (see BMD). By default, the "BMR = 0.1."} + +\item{alpha}{Alpha is the specified nominal coverage rate for computation of the lower bound on the BMDL and BMDU, i.e., one computes a \eqn{100\times(1-\alpha)\%} . For the interval (BMDL,BMDU) this is a \eqn{100\times(1-2\alpha)\% } confidence interval. By default, it is set to 0.05.} + \item{degree}{the number of degrees of a polynomial model. Only used for polynomial models.} \item{samples}{the number of samples to take (MCMC only)} \item{burnin}{the number of burnin samples to take (MCMC only)} - -\item{BRM}{This option specifies the benchmark response BMR. The BMR is defined in relation to the BMD calculation requested (see BMD). By default, the "BMR = 0.1."} } \value{ a model object @@ -47,7 +54,7 @@ mData <- matrix(c(0, 2,50, 3, 10, 50, 16, 18,50, 32, 18,50, - 33, 17,50),nrow=6,ncol=3,byrow=T) + 33, 17,50),nrow=6,ncol=3,byrow=TRUE) D <- mData[,1] Y <- mData[,2] N <- mData[,3] diff --git a/src/CHANGELOG.md b/src/CHANGELOG.md new file mode 100644 index 0000000..6ca6717 --- /dev/null +++ b/src/CHANGELOG.md @@ -0,0 +1,27 @@ +# Changes + +## Version 22.05 (1.0.1) + +### The following fixes are in version 1.0.1: + + - Function `single_continuous_fit' fixed prior issue with Log-Normal data, when sufficient statistics are given. + - Log-Normal deviance for Exponential 3/5 was producing incorrect values. Now reporting correct values. + - Function `single_dichotomous_fit' did not return bmd_dist as an element of the return object when fit_type = 'mcmc'. + - Dichotomous MA individual models were mislabled. They now are consistant with Continuous model averaging using the + `Individual_model' naming. + - Inf, NA, NaN rows are now removed before fitting. + +### The following changes to fitting were made: + + - Changed the profile likelihood stopping criteria for profile likelihood equality constrained optimization for continuous models to be 5e-5 for the absolute change in the parameter value, i.e., |\beta_n - \beta_{n+1}| < 5e-5 is the stopping criteria. + - When OpenMP is enabled, the fitting of single continuous models and deviance models is done with multiple threads. + - MCMC Metropolis-Hastings algorithm proposal changed. Proposals are now 125% MAP variance. This change improves mixing and increases effective + sample size by around 10 to 20%. + +### The following additional functionality was added: + + - Added summary/print functions for Single Continuous and Single Dichotomous Models. + - Added summary/print function for Model Averaging. + - ntp tests (Williams/Shirley/PolyK/Dunn/Dunnett) e.g. ?ntp_williams + - Data set from Wheeler, Bailer, Piegorsh (2019) added. + diff --git a/src/Makevars b/src/Makevars deleted file mode 100644 index 4ad11d3..0000000 --- a/src/Makevars +++ /dev/null @@ -1,28 +0,0 @@ -#USE_SIMD = 0 NO VECTOR INSTRUCTIONS -DUSE_SIMD=1 -#USE_SIMD = 1 USE AVX/AVX2 INSTRUCTIONS -#USE_SIMD = 2 USE AVX2512 INSTRUCTIONS-DUSE_SIMD=1 -DNDEBUG -DEIGEN_NO_DEBUG -DEIGEN_NO_DEBUG - #-fopenmp - -DISTRO = $(shell uname) - -ifeq ($(DISTRO), Linux) - PKG_CPPFLAGS = -I"./include" -I"./code_base" -ftree-vectorize -Os -march=native - PKG_CPPFLAGS += $(shell pkg-config --cflags nlopt gsl) -DR_COMPILATION -Wno-ignored-attributes -flto -fopenmp - PKG_LIBS = $(shell pkg-config --libs nlopt gsl) -else - PKG_CPPFLAGS = -I"./code_base" -I"./include" -ftree-vectorize -Os -fopenmp - PKG_CPPFLAGS += -DR_COMPILATION -Wno-ignored-attributes -DNDEBUG $(shell pkg-config --cflags nlopt gsl) #-fopenmp -# PKG_LIBS = -lomp -Wl, -Bstatic $(shell pkg-config --libs nlopt gsl) - PKG_LIBS = -lomp $(shell pkg-config --libs nlopt gsl) -endif - -#MAKEFLAGS = -j4 - - -POLYK = $(wildcard polyK/*.cpp) -MAIN = $(wildcard *.cpp) -MAIN_CODE = $(wildcard code_base/*.cpp) -OBJECTS = $(MAIN:.cpp=.o) $(MAIN_CODE:.cpp=.o) $(POLYK:.cpp=.o) - - - diff --git a/src/Makevars.in b/src/Makevars.in new file mode 100644 index 0000000..d333327 --- /dev/null +++ b/src/Makevars.in @@ -0,0 +1,20 @@ +PKG_CXXFLAGS = -I./code_base -I./include @OPENMP@ @NLOPT_CPPFLAGS@ @GSL_CPPFLAGS@ -DR_COMPILATION +PKG_LIBS = $(LAPACK_LIBS) $(BLAS_LIBS) $(FLIBS) @NLOPT_LIBS@ @GSL_LIBS@ @OPENMP@ + +# Include all C++ files in src/ and its subdirectories +SOURCES=@SRC_SOURCES@ @SUBDIR_SOURCES@ + +# Obtain the object files +OBJECTS=$(SOURCES:.cpp=.o) + +# Make the shared object +all: $(SHLIB) + +# Provide recipe to remove all objects +clean: + @rm -f $(OBJECTS) + + + + + diff --git a/src/Makevars.ucrt b/src/Makevars.ucrt new file mode 100644 index 0000000..1009046 --- /dev/null +++ b/src/Makevars.ucrt @@ -0,0 +1,10 @@ +PKG_CXXFLAGS = -I./code_base -I./include $(SHLIB_OPENMP_CXXFLAGS) -I$(R_TOOLS_SOFT)/include/nlopt -I$(R_TOOLS_SOFT)/include/gsl -DR_COMPILATION -ftree-vectorize -Os +PKG_LIBS = $(LAPACK_LIBS) $(BLAS_LIBS) $(FLIBS) $(SHLIB_OPENMP_CXXFLAGS) -lgsl -lgslcblas -lnlopt + +POLYK = $(wildcard polyK/*.cpp) +MAIN = $(wildcard *.cpp) +MAIN_CODE = $(wildcard code_base/*.cpp) +OBJECTS = $(MAIN:.cpp=.o) $(MAIN_CODE:.cpp=.o) $(POLYK:.cpp=.o) + + + diff --git a/src/Makevars.win b/src/Makevars.win index d108d3f..8d0f6ac 100644 --- a/src/Makevars.win +++ b/src/Makevars.win @@ -1,15 +1,11 @@ - -# $topdir is set by the involking batch script -PKG_CPPFLAGS = -I"./code_base" -I"./include" -ftree-vectorize -Os #-O3 -mavx2 -PKG_CPPFLAGS += -fopenmp -DR_COMPILATION -Wno-ignored-attributes -DEIGEN_NO_DEBUG -DNDEBUG $(shell pkg-config --cflags nlopt gsl) -#PKG_CPPFLAGS += -I"$(topdir)$(R_ARCH)/include/" -MAKEFLAGS = -j4 -#PKG_LIBS = -fopenmp -L"$(topdir)/$(R_ARCH)/lib/" -fabi-version=2 -lgsl -PKG_LIBS = $(shell pkg-config --libs nlopt gsl) -fopenmp -fabi-version=2 -PKG_LIBS += -lnlopt -lRblas -lRlapack -fPIC - -POLYK = $(wildcard polyK/*.cpp) -MAIN = $(wildcard *.cpp) -MAIN_CODE = $(wildcard code_base/*.cpp) -OBJECTS = $(MAIN:.cpp=.o) $(MAIN_CODE:.cpp=.o) $(POLYK:.cpp=.o) - +PKG_CXXFLAGS = -I./ -I./code_base -I./include $(SHLIB_OPENMP_CXXFLAGS) -I$(R_TOOLS_SOFT)/include/nlopt +-I$(R_TOOLS_SOFT)/include/gsl -DR_COMPILATION -ftree-vectorize -Os +PKG_LIBS = $(LAPACK_LIBS) $(BLAS_LIBS) $(FLIBS) $(SHLIB_OPENMP_CXXFLAGS) -lgsl -lgslcblas -lnlopt + +POLYK = $(wildcard polyK/*.cpp) +MAIN = $(wildcard *.cpp) +MAIN_CODE = $(wildcard code_base/*.cpp) +OBJECTS = $(MAIN:.cpp=.o) $(MAIN_CODE:.cpp=.o) $(POLYK:.cpp=.o) + + + diff --git a/src/code_base/continuous_clean_aux.cpp b/src/code_base/continuous_clean_aux.cpp index e14fbf5..aa27aca 100644 --- a/src/code_base/continuous_clean_aux.cpp +++ b/src/code_base/continuous_clean_aux.cpp @@ -281,7 +281,7 @@ Eigen::MatrixXd rescale_parms(Eigen::MatrixXd parms, cont_model model, double ma COV = scaleMatrix*COV*scaleMatrix.transpose(); break; case cont_model::polynomial: - + default: for (int i = 1; i <= degree; i++){ scaleMatrix(i,i) *= pow(1/max_dose,i); } diff --git a/src/code_base/continuous_entry_code.cpp b/src/code_base/continuous_entry_code.cpp index 127fffc..7a1e771 100644 --- a/src/code_base/continuous_entry_code.cpp +++ b/src/code_base/continuous_entry_code.cpp @@ -397,6 +397,7 @@ double compute_lognormal_dof(Eigen::MatrixXd Y,Eigen::MatrixXd X, Eigen::MatrixX } break; case cont_model::exp_5: + default: if (is_increasing){ Xd = X_gradient_cont(estimate,Y,X,suff_stat,NORMAL_EXP5_UP); cv_t = X_cov_cont< lognormalEXPONENTIAL_BMD_NC>(estimate,Y,X,suff_stat, NORMAL_EXP5_UP); @@ -530,6 +531,7 @@ double compute_normal_dof(Eigen::MatrixXd Y,Eigen::MatrixXd X, Eigen::MatrixXd e break; case cont_model::power: + default: Xd = X_gradient_cont_norm(estimate,Y,X,CV,suff_stat); cv_t = X_cov_cont_norm(estimate,Y,X,CV,suff_stat); @@ -929,6 +931,7 @@ bmd_analysis laplace_Normal(Eigen::MatrixXd Y,Eigen::MatrixXd X, } break; case cont_model::polynomial: + default: #ifdef R_COMPILATION if (bConstVar){ //cout << "Running Polynomial Model Normality Assumption using Laplace." << endl; @@ -2779,10 +2782,10 @@ void continuous_expectation( const continuous_analysis *CA, const continuous_mod Y_LN = cleanSuffStat(SSTAT_LN,UX,true); orig_X = UX; orig_Y = SSTAT; - orig_Y_LN = SSTAT_LN; + orig_Y_LN = SSTAT; }else{ - Y = Y; // scale the data with the divisor term. + //Y = Y; // scale the data with the divisor term. Y_N = Y; Y_LN = Y; } @@ -2885,7 +2888,7 @@ void continuous_expectation( const continuous_analysis *CA, const continuous_mod } break; case cont_model::exp_5: - + default: if (CA->isIncreasing){ mean = likelihood_lnexp5U.mean(theta,myX); var = likelihood_lnexp5U.variance(theta,myX); @@ -2933,6 +2936,7 @@ void continuous_expectation( const continuous_analysis *CA, const continuous_mod } break; case cont_model::exp_5: + default: if (CA->isIncreasing){ mean = likelihood_nexp5U.mean(theta,myX); var = likelihood_nexp5U.variance(theta,myX); diff --git a/src/code_base/continuous_entry_code.h b/src/code_base/continuous_entry_code.h index 45939b8..32ac8f2 100644 --- a/src/code_base/continuous_entry_code.h +++ b/src/code_base/continuous_entry_code.h @@ -157,7 +157,7 @@ Eigen::MatrixXd X_gradient_cont( Eigen::MatrixXd theta,Eigen::MatrixXd Y, } } - delete grad; + delete[] grad; return rValue; } diff --git a/src/code_base/dichotomous_entry_code.cpp b/src/code_base/dichotomous_entry_code.cpp index 61856f6..b6911c3 100644 --- a/src/code_base/dichotomous_entry_code.cpp +++ b/src/code_base/dichotomous_entry_code.cpp @@ -821,8 +821,9 @@ void compute_dichotomous_pearson_GOF(dichotomous_PGOF_data *data, dichotomous_PG } res->n = data->n; // total number of observations obs res->test_statistic = sqresid.array().sum(); + if ( data->n-data->model_df > 0.0){ - res->p_value = 1.0 - gsl_cdf_chisq_P(sqresid.array().sum(),data->n-data->model_df); + res->p_value = 1.0 - gsl_cdf_chisq_P(sqresid.array().sum(),data->n-data->model_df); }else{ res->p_value = 1.0; } diff --git a/src/code_base/lognormalModels.cpp b/src/code_base/lognormalModels.cpp index 5bdb6f3..35e6498 100644 --- a/src/code_base/lognormalModels.cpp +++ b/src/code_base/lognormalModels.cpp @@ -169,10 +169,10 @@ Eigen::MatrixXd lognormalLLModel::starting_value(Eigen::MatrixXd theta, contbmd try{ result = opt.optimize(x, minf); good_opt = true; - }catch (nlopt::roundoff_limited) { + }catch (nlopt::roundoff_limited &exec) { good_opt = false; } - catch (nlopt::forced_stop) { + catch (nlopt::forced_stop &exec) { good_opt = false; } catch (const std::exception &exc) { diff --git a/src/code_base/normalModels.cpp b/src/code_base/normalModels.cpp index 432fadd..2faccb4 100644 --- a/src/code_base/normalModels.cpp +++ b/src/code_base/normalModels.cpp @@ -170,10 +170,10 @@ Eigen::MatrixXd normalLLModel::starting_value(Eigen::MatrixXd theta, contbmd BMD try{ result = opt.optimize(x, minf); good_opt = true; - }catch (nlopt::roundoff_limited) { + }catch (nlopt::roundoff_limited &exec) { good_opt = false; } - catch (nlopt::forced_stop) { + catch (nlopt::forced_stop &exec) { good_opt = false; } catch (const std::exception &exc) { diff --git a/src/include/DichHillBMD_NC.h b/src/include/DichHillBMD_NC.h index e43de58..7666df0 100644 --- a/src/include/DichHillBMD_NC.h +++ b/src/include/DichHillBMD_NC.h @@ -80,7 +80,7 @@ class dich_hillModelNC : public binomialBMD { } else { Z = HILL_ADDED_Z(g,n, a, NULL, BMR); - temp = temp = (Z - ub * log(BMD))*1.1; // add a little extra so the constraint is satisfied + temp = (Z - ub * log(BMD))*1.1; // add a little extra so the constraint is satisfied x[0] = theta(0, 0); x[1] = theta(1, 0); x[2] = theta(2, 0) - temp; diff --git a/src/include/binomModels.h b/src/include/binomModels.h index f3185c6..6af9120 100644 --- a/src/include/binomModels.h +++ b/src/include/binomModels.h @@ -126,7 +126,7 @@ class binomialBMD : public binomialLL { mpoint = (max + min) / 2.0; dose = XgivenD(mpoint); a = mean(theta, dose)(0, 0); - test = test = (a - b) / (1 - b) - BMR; + test = (a - b) / (1 - b) - BMR; } return mpoint; diff --git a/src/include/bmd_calculate.h b/src/include/bmd_calculate.h index a146706..59eaf1c 100644 --- a/src/include/bmd_calculate.h +++ b/src/include/bmd_calculate.h @@ -269,9 +269,10 @@ class bmd_cdf { class bmd_analysis { public: - bmd_cdf BMD_CDF; + Eigen::MatrixXd MAP_ESTIMATE; Eigen::MatrixXd COV; + bmd_cdf BMD_CDF; bool isExtra; double BMR; double MAP_BMD; @@ -281,7 +282,7 @@ class bmd_analysis { std::vector expected; bmd_analysis() : MAP_ESTIMATE(), COV(), BMD_CDF() { - + } bmd_analysis(const bmd_analysis &M) { BMD_CDF = M.BMD_CDF; diff --git a/src/include/cBMDstatmod.h b/src/include/cBMDstatmod.h index df31bd3..596df7f 100644 --- a/src/include/cBMDstatmod.h +++ b/src/include/cBMDstatmod.h @@ -328,10 +328,10 @@ optimizationResult cfindMAX_W_EQUALITY( cBMDModel *M, nlopt::opt local_opt(nlopt::LD_LBFGS, M->nParms()); //BOBYQA nlopt::opt local_opt2(nlopt::LN_SBPLX, M->nParms()); ///////////////////////////////////////////////////////// - local_opt.set_xtol_abs(1e-5); - local_opt2.set_xtol_abs(1e-5); - local_opt.set_initial_step(1e-5); - local_opt2.set_initial_step(1e-5); + local_opt.set_xtol_abs(5e-5); + local_opt2.set_xtol_abs(5e-5); + local_opt.set_initial_step(5e-5); + local_opt2.set_initial_step(5e-5); local_opt.set_maxeval(10000); local_opt2.set_maxeval(10000); ///////////////////////////////////////////////////////// @@ -347,7 +347,7 @@ optimizationResult cfindMAX_W_EQUALITY( cBMDModel *M, opt.set_min_objective(neg_pen_likelihood, M); opt.set_lower_bounds(lb); opt.set_upper_bounds(ub); - opt.set_xtol_abs(1e-5); + opt.set_xtol_abs(5e-5); opt.set_maxeval(20000); /////////////////////////////////////////////// @@ -357,10 +357,10 @@ optimizationResult cfindMAX_W_EQUALITY( cBMDModel *M, try { result = opt.optimize(x, minf); good_opt = true; - }catch (nlopt::roundoff_limited) { + }catch (nlopt::roundoff_limited &exc) { good_opt = false; //cout << "Error Round off" << endl; - }catch (nlopt::forced_stop) { + }catch (nlopt::forced_stop &exc) { good_opt = false; //cout << "Error Forced stop" << endl; } @@ -560,12 +560,12 @@ optimizationResult cfindMAX_W_BOUND(cBMDModel *M, good_opt = true; //opt_iter++; } - catch (nlopt::roundoff_limited) { + catch (nlopt::roundoff_limited &exc) { good_opt = false; DEBUG_LOG(file, "opt_iter= " << opt_iter << ", error: roundoff_limited"); // cout << "Error Round off" << endl; } - catch (nlopt::forced_stop) { + catch (nlopt::forced_stop &exc) { good_opt = false; DEBUG_LOG(file, "opt_iter= " << opt_iter << ", error: roundoff_limited"); // cout << "Error Forced stop" << endl; diff --git a/src/include/dBMDstatmod.h b/src/include/dBMDstatmod.h index b3a4b5e..1144afb 100644 --- a/src/include/dBMDstatmod.h +++ b/src/include/dBMDstatmod.h @@ -480,10 +480,10 @@ optimizationResult findMAX_W_EQUALITY( dBMDModel *M, try { result = opt.optimize(x, minf); good_opt = true; //optimization succeded - }catch (nlopt::roundoff_limited) { + }catch (nlopt::roundoff_limited &exec) { good_opt = false; //cerr << "Round Off Limited" << endl; - }catch (nlopt::forced_stop) { + }catch (nlopt::forced_stop &exec) { good_opt = false; //cerr << "Forced Stop" << endl; } @@ -738,7 +738,7 @@ std::list fit_profileLogic(dBMDModel *M, algorithm); } - catch (nlopt::roundoff_limited) { + catch (nlopt::roundoff_limited &exec) { //TODO check to see if their is a roundoff limitation we // mark the failure and set the maximum function value to infinity. result(0, 0) = DBL_MAX; result(1, 0) = BMD; result(2, 0) = NLOPT_ROUNDOFF_LIMITED; @@ -747,7 +747,7 @@ std::list fit_profileLogic(dBMDModel *M, // cout << "AB" << endl; return rV; } - catch (nlopt::forced_stop) { + catch (nlopt::forced_stop &exec) { result(0, 0) = DBL_MAX; result(1, 0) = BMD; result(2, 0) = NLOPT_FORCED_STOP; bad_result = true; rV.push_front(result); diff --git a/src/include/mcmc_analysis.h b/src/include/mcmc_analysis.h index 303827d..e0aaf0e 100644 --- a/src/include/mcmc_analysis.h +++ b/src/include/mcmc_analysis.h @@ -102,9 +102,15 @@ mcmcSamples MCMC_bmd_analysis_DNC(Eigen::MatrixXd Y, Eigen::MatrixXd D, Eigen::M // now sample, samples, number of proposals for the // metropolis sampler. - + /* + FullPivLU lu_decomp(your_matrix); + auto rank = lu_decomp.rank(); + */ + double eps = 1.25; Eigen::MatrixXd mu = oR.max_parms; - Eigen::MatrixXd cov = 0.75*model.varMatrix(oR.max_parms); + Eigen::MatrixXd cov = pow(eps,2)*model.varMatrix(oR.max_parms); + + Eigen::MatrixXd chol = cov.llt().matrixL(); Eigen::MatrixXd nSamples = chol*rNormal; // variance of each row // is is now L'L = cov @@ -216,9 +222,9 @@ mcmcSamples mcmc_continuous(cBMDModel *model, int samples, } // now sample From a metropolis-Hastings sampler. + double eps = 1.25; Eigen::MatrixXd mu = oR.max_parms; - - Eigen::MatrixXd cov = 0.625*model->varMatrix(oR.max_parms); + Eigen::MatrixXd cov = pow(eps,2)*model->varMatrix(oR.max_parms); Eigen::MatrixXd chol = cov.llt().matrixL(); Eigen::MatrixXd nSamples = chol*rNormal; // variance of each row // is is now LL' = cov diff --git a/src/include/statmod.h b/src/include/statmod.h index 17c1947..9c42e85 100644 --- a/src/include/statmod.h +++ b/src/include/statmod.h @@ -300,6 +300,13 @@ Eigen::MatrixXd statModel::varMatrix(Eigen::MatrixXd theta) { } // m = m.inverse(); + Eigen::FullPivLU lu_decomp(m); + auto rank = lu_decomp.rank(); + // matrix is less than full rank + // so we add an epsolon error to fix it + if (rank < m.rows()){ + m = m + 1e-4*Eigen::MatrixXd::Identity(m.rows(),m.cols()); + } return m.inverse(); } @@ -391,8 +398,8 @@ std::vector startValue_F(statModel *M, gsl_rng * r; gsl_rng_env_setup(); - T = gsl_rng_default; - r = gsl_rng_alloc (T); + // T = gsl_rng_default; + r = gsl_rng_alloc (gsl_rng_mt19937); gsl_rng_set(r, 8675309); // set the same seed for every GA run population.push_back(startV); @@ -747,11 +754,11 @@ optimizationResult findMAP(statModel *M, DEBUG_LOG(file, "opt_iter= " << opt_iter << ", error: invalid arg: " << exc.what()); } // catch - catch (nlopt::roundoff_limited) { + catch (nlopt::roundoff_limited &exec) { DEBUG_LOG(file, "opt_iter= " << opt_iter << ", error: roundoff_limited"); // cout << "bogo" << endl; } // catch - catch (nlopt::forced_stop) { + catch (nlopt::forced_stop &exec) { DEBUG_LOG(file, "opt_iter= " << opt_iter << ", error: forced_stop"); // cout << "there" << endl; } // catch diff --git a/src/main_entry.cpp b/src/main_entry.cpp index 2c7cc21..8caff8d 100644 --- a/src/main_entry.cpp +++ b/src/main_entry.cpp @@ -73,7 +73,7 @@ using namespace Rcpp; // run the corresponding analysis. // output: BMD analysis with the model specified by NumericVector model // -// [[Rcpp::export]] +// [[Rcpp::export(".run_single_dichotomous")]] List run_single_dichotomous(NumericVector model, Eigen::MatrixXd data, Eigen::MatrixXd pr, NumericVector options1, IntegerVector options2) @@ -173,7 +173,7 @@ List run_single_dichotomous(NumericVector model, // correctly by the R calling function), and then calls the library to // run the corresponding analysis. // output: BMD analysis with the model specified by NumericVector model -// [[Rcpp::export]] +// [[Rcpp::export(".run_continuous_single")]] List run_continuous_single(IntegerVector model, Eigen::MatrixXd Y, Eigen::MatrixXd X, Eigen::MatrixXd prior, NumericVector options, @@ -244,21 +244,31 @@ List run_continuous_single(IntegerVector model, anal.parms, 200); //have 200 equally spaced values //////////////////////////////////// - - estimate_sm_laplace(&anal,result,isFast); - continuous_deviance aod1; - - if (anal.disttype == distribution::log_normal){ - - estimate_log_normal_aod(&anal, - &aod1); - - }else{ - estimate_normal_aod(&anal, - &aod1); - } + #pragma omp parallel + { + #pragma omp sections + { + #pragma omp section + { + estimate_sm_laplace(&anal,result,isFast); + } + #pragma omp section + { + + if (anal.disttype == distribution::log_normal){ + + estimate_log_normal_aod(&anal, + &aod1); + + }else{ + estimate_normal_aod(&anal, + &aod1); + } + } + } + } continuous_expected_result exp_r; exp_r.expected = new double[anal.n]; exp_r.n = anal.n; exp_r.sd = new double[anal.n]; @@ -269,7 +279,7 @@ List run_continuous_single(IntegerVector model, AOD(0,0) = aod1.A1; AOD(0,1) = aod1.N1; AOD(1,0) = aod1.A2; AOD(1,1) = aod1.N2; AOD(2,0) = aod1.A3; AOD(2,1) = aod1.N3; - AOD(3,0) = aod1.R; AOD(3,1) = aod1.NR; + AOD(3,0) = aod1.R; AOD(3,1) = aod1.NR; AOD(4,0) = exp_r.like; AOD(4,1) = result->model_df; List rV = convert_continuous_fit_to_list(result); diff --git a/src/main_entry_ma.cpp b/src/main_entry_ma.cpp index edd1021..daddd42 100644 --- a/src/main_entry_ma.cpp +++ b/src/main_entry_ma.cpp @@ -271,7 +271,7 @@ List convert_continuous_maresults_to_list(continuousMA_result *result){ ///////////////////////////////////////////////////////////////////////////// // ///////////////////////////////////////////////////////////////////////////// -// [[Rcpp::export]] +// [[Rcpp::export(".run_continuous_ma_laplace")]] List run_continuous_ma_laplace(List model_priors, NumericVector model_type, NumericVector dist_type, Eigen::MatrixXd Y, Eigen::MatrixXd X, @@ -392,7 +392,7 @@ List convert_mcmc_results(const ma_MCMCfits *a){ // // ///////////////////////////////////////////////////////////////////////////// -// [[Rcpp::export]] +// [[Rcpp::export(".run_continuous_ma_mcmc")]] List run_continuous_ma_mcmc(List model_priors, NumericVector model_type, NumericVector dist_type, Eigen::MatrixXd Y, Eigen::MatrixXd X, @@ -502,7 +502,7 @@ List run_continuous_ma_mcmc(List model_priors, NumericVector model_type, // function: List run_ma_dichotomous() // Purpose: runs a model average based on the prior // -// [[Rcpp::export]] +// [[Rcpp::export(.run_ma_dichotomous)]] List run_ma_dichotomous(Eigen::MatrixXd data, List priors, NumericVector models, NumericVector model_p, bool is_MCMC, NumericVector options1, IntegerVector options2){ diff --git a/src/main_entry_mcmc.cpp b/src/main_entry_mcmc.cpp index 8278fe2..5b71a9b 100644 --- a/src/main_entry_mcmc.cpp +++ b/src/main_entry_mcmc.cpp @@ -145,7 +145,7 @@ Eigen::MatrixXd fix_sample(Eigen::MatrixXd A, dich_model mtype, double max){ // correctly by the R calling function), and then calls the library to // run the corresponding analysis. Does MCMC sample // output: BMD analysis with the model specified by NumericVector model -// [[Rcpp::export]] +// [[Rcpp::export(".run_dichotomous_single_mcmc")]] List run_dichotomous_single_mcmc(NumericVector model, Eigen::MatrixXd Y, Eigen::MatrixXd D, Eigen::MatrixXd pr, NumericVector options){ @@ -227,7 +227,7 @@ List run_dichotomous_single_mcmc(NumericVector model, // correctly by the R calling function), and then calls the library to // run the corresponding analysis. Does MCMC sample // output: BMD analysis with the model specified by NumericVector model -// [[Rcpp::export]] +// [[Rcpp::export(".run_continuous_single_mcmc")]] List run_continuous_single_mcmc(NumericVector model, Eigen::MatrixXd Y, Eigen::MatrixXd D, Eigen::MatrixXd priors, NumericVector options, diff --git a/src/nlopt-src.tar.gz b/src/nlopt-src.tar.gz new file mode 100644 index 0000000..7bfddd6 Binary files /dev/null and b/src/nlopt-src.tar.gz differ diff --git a/src/polyK/polyK.cpp b/src/polyK/polyK.cpp index 2e21ffa..c3eb066 100644 --- a/src/polyK/polyK.cpp +++ b/src/polyK/polyK.cpp @@ -344,7 +344,7 @@ double TDMSE_PolyK::polyk_mod(PolyKPrepareClass subsetVars, if(fabs(test_stat) < TESTSTAT_EPSILON) pvalue = 0.5; if(top < 0) pvalue = -1 * pvalue; } - catch (std::exception e) + catch (std::exception &e) { // System.out.println("Exception in polyk_mod = " + e); pvalue = BAD_PVALUE; diff --git a/src/polyK/polyK_setup.cpp b/src/polyK/polyK_setup.cpp index db50d7c..986b158 100644 --- a/src/polyK/polyK_setup.cpp +++ b/src/polyK/polyK_setup.cpp @@ -37,7 +37,7 @@ bool PolyKPrepareClass::SetupStudy(std::vector dose, std::vector tu an.set(dose[i], tumor[i], daysOnStudy[i]); m_AnimalList.push_back(an); } - }catch (std::exception ex) { + }catch (std::exception &ex) { return false; } return true; diff --git a/src/scripts/cmake_config.sh b/src/scripts/cmake_config.sh new file mode 100755 index 0000000..68b5b98 --- /dev/null +++ b/src/scripts/cmake_config.sh @@ -0,0 +1,38 @@ +#### CMAKE CONFIGURATION #### + +if test -z "$CMAKE_BIN"; then + # Look for a cmake3 binary in the current path + CMAKE_BIN=`which cmake3 2>/dev/null` +fi + +if test -z "$CMAKE_BIN"; then + # Look for a cmake binary in the current path + CMAKE_BIN=`which cmake 2>/dev/null` +fi + +if test -z "$CMAKE_BIN"; then + # Check for a MacOS specific path + CMAKE_BIN=`which /Applications/CMake.app/Contents/bin/cmake 2>/dev/null` +fi + +if test -z "$CMAKE_BIN"; then + echo "" + echo "------------------ CMAKE NOT FOUND --------------------" + echo "" + echo "CMake was not found on the PATH. Please install CMake:" + echo "" + echo " - sudo yum install cmake (Fedora/CentOS; inside a terminal)" + echo " - sudo apt install cmake (Debian/Ubuntu; inside a terminal)." + echo " - sudo pacman -S cmake (Arch Linux; inside a terminal)." + echo " - sudo brew install cmake (MacOS; inside a terminal with Homebrew)" + echo " - sudo port install cmake (MacOS; inside a terminal with MacPorts)" + echo "" + echo "Alternatively install CMake from: " + echo "" + echo "-------------------------------------------------------" + echo "" + + exit 1 +fi + +echo set CMAKE_BIN=$CMAKE_BIN diff --git a/src/scripts/nlopt_cleanup.sh b/src/scripts/nlopt_cleanup.sh new file mode 100644 index 0000000..be91184 --- /dev/null +++ b/src/scripts/nlopt_cleanup.sh @@ -0,0 +1,4 @@ +#!/bin/sh + +cp nlopt${R_ARCH}/include/* ../inst/include/ +rm -fr nlopt-src diff --git a/src/scripts/nlopt_download.sh b/src/scripts/nlopt_download.sh new file mode 100644 index 0000000..883ad39 --- /dev/null +++ b/src/scripts/nlopt_download.sh @@ -0,0 +1,16 @@ +#! /bin/sh + +RSCRIPT_BIN=$1 +echo $1 +echo $1 +echo $1 +echo $1 +echo $1 +echo "-----------------------------" +echo "-----------------------------" +echo "-----------------------------" +echo "-----------------------------" + +# Uncompress NLOPT source +${RSCRIPT_BIN} -e "utils::untar(tarfile = 'nlopt-src.tar.gz')" +mv nlopt-2.7.1 nlopt-src diff --git a/src/scripts/nlopt_install.sh b/src/scripts/nlopt_install.sh new file mode 100644 index 0000000..791cd33 --- /dev/null +++ b/src/scripts/nlopt_install.sh @@ -0,0 +1,9 @@ +#! /bin/sh + +CMAKE_BIN=$1 +NCORES=$2 +ARCH=$3 + +"${CMAKE_BIN}" --build nlopt${ARCH}-build -j ${NCORES} --config Release +"${CMAKE_BIN}" --install nlopt${ARCH}-build --prefix nlopt${ARCH} +rm -fr nlopt${ARCH}-build diff --git a/src/scripts/r_config.sh b/src/scripts/r_config.sh new file mode 100755 index 0000000..5f2118a --- /dev/null +++ b/src/scripts/r_config.sh @@ -0,0 +1,44 @@ +#### R CONFIGURATION #### + +R_ARCH_BIN=$1 + +CC=`"${R_HOME}/bin${R_ARCH_BIN}/R" CMD config CC` +echo set CC=$CC +export CC + +CPPFLAGS=`"${R_HOME}/bin${R_ARCH_BIN}/R" CMD config CPPFLAGS` +CFLAGS=`"${R_HOME}/bin${R_ARCH_BIN}/R" CMD config CFLAGS` +CPICFLAGS=`"${R_HOME}/bin${R_ARCH_BIN}/R" CMD config CPICFLAGS` + +CFLAGS="$CPPFLAGS $CPICFLAGS $CFLAGS" +echo set CFLAGS=$CFLAGS +export CFLAGS + +CXX=`"${R_HOME}/bin${R_ARCH_BIN}/R" CMD config CXX11` +echo set CXX=$CXX +export CXX + +CXXSTD=`"${R_HOME}/bin${R_ARCH_BIN}/R" CMD config CXX11STD` +CXXFLAGS=`"${R_HOME}/bin${R_ARCH_BIN}/R" CMD config CXX11FLAGS` +CXXPICFLAGS=`"${R_HOME}/bin${R_ARCH_BIN}/R" CMD config CXX11PICFLAGS` + +CXXFLAGS="$CXXSTD $CPPFLAGS $CXXPICFLAGS $CXXFLAGS" +echo set CXXFLAGS=$CXXFLAGS +export CXXFLAGS + +LDFLAGS=`"${R_HOME}/bin${R_ARCH_BIN}/R" CMD config LDFLAGS` +echo set LDFLAGS=$LDFLAGS +export LDFLAGS + +if test -z "$CXX"; then + echo >&2 "Could not detect C++ compiler with R CMD config." +fi + +${R_HOME}/bin${R_ARCH_BIN}/Rscript --vanilla -e 'getRversion() > "4.0.0"' | grep TRUE > /dev/null +if [ $? -eq 0 ]; then + AR=`"${R_HOME}/bin${R_ARCH_BIN}/R" CMD config AR` + AR=`which $AR` + + RANLIB=`"${R_HOME}/bin${R_ARCH_BIN}/R" CMD config RANLIB` + RANLIB=`which $RANLIB` +fi diff --git a/tests/testthat/helper.R b/tests/testthat/helper.R index ac470f6..39db719 100644 --- a/tests/testthat/helper.R +++ b/tests/testthat/helper.R @@ -10,6 +10,26 @@ build_single_continuous_dataset <- function(){ M2 } +build_single_dichotomous_dataset_2 <- function(){ + mData <- matrix(c(0, 39,297, + 0.00098, 24,90, + 0.0098, 32, 87, + 0.098 , 136, 148), + nrow=4,ncol=3,byrow=T) + return(mData) +} + + +validate_model2 <- function(model, name, parameters, bmd_estimates, + gof){ + expect_equal(name, model$full_model) + expect_equal(parameters, model$parameters, tolerance=10e-3) + expect_equal(setNames(bmd_estimates, c("BMD", "BMDL", "BMDU")), model$bmd, tolerance=10e-3) + A = summary(model) + expect_equal(as.numeric(A$GOF),gof,tolerance = 10e-3) + +} + build_single_dichotomous_dataset <- function(){ mData <- matrix(c(0, 2,50, 1, 2,50, @@ -62,7 +82,7 @@ build_ma_dataset <- function(){ doses <- rep(c(0,6.25,12.5,25,50,100),each=10) dosesq <- rep(c(0,6.25,12.5,25,50,100),each=30) - mean <- cont_hill_f(as.numeric(hill[2,]),doses) + mean <- ToxicR:::.cont_hill_f(as.numeric(hill[2,]),doses) y <- rinvgauss(length(mean),mean,18528.14) return(list(doses=doses, y=y)) } @@ -73,7 +93,7 @@ build_model_list <- function(y){ "normal-ncv")) model_list = list() for (i in 1:nrow(model_listA)){ - t_prior = bayesian_prior_continuous_default(model_listA$model_list[i],model_listA$distribution_list[i]) + t_prior = ToxicR:::.bayesian_prior_continuous_default(model_listA$model_list[i],model_listA$distribution_list[i]) if(model_listA$distribution_list[i] == "lognormal"){ t_prior$priors[nrow(t_prior$priors),2] = log(var(log(y))) }else{ diff --git a/tests/testthat/test-ma_dichotomous.R b/tests/testthat/test-ma_dichotomous.R index ee1ae7f..245e9d4 100644 --- a/tests/testthat/test-ma_dichotomous.R +++ b/tests/testthat/test-ma_dichotomous.R @@ -6,20 +6,20 @@ test_that("Defaults", { AA = ma_dichotomous_fit(mData[,1],mData[,2],mData[,3]) - expect_equal(c("BMDdichotomous_MA", "BMDdichotomous_MA_maximized"), class(AA)) + expect_equal(c("BMDdichotomous_MA", "BMDdichotomous_MA_laplace"), class(AA)) expect_equal(13, length(AA)) expect_equal(setNames(c(4.17, 1.33, 12.318), c("BMD", "BMDL", "BMDU")), AA$bmd, tolerance=10e-2) expect_equal(c(0.427802462, 0.021635893, 0.022796957, 0.109884198, 0.006866267, 0.001184459, 0.025631532, 0.291857962, 0.092340269), AA$posterior_probs, tolerance=10e-2) #generate_validation_code(AA) - validate_model( AA$Fitted_Model_1 , "Model: Hill" , c(-3.1514129532799, -0.542504910549596, -2.21526647189887, 1.38193548558345) , c(2.43689558842919, 1.19423317401394, 5.66302904194827) ) - validate_model( AA$Fitted_Model_2 , "Model: Gamma" , c(-2.58597525196282, 0.859030175600515, 0.0103251850555099) , c(6.46707681632849, 2.71101742377789, 13.1872288945701) ) - validate_model( AA$Fitted_Model_3 , "Model: Logistic" , c(-2.0069607207327, 0.0463222123387509) , c(14.2821369829316, 11.7611052273976, 18.9167440555661) ) - validate_model( AA$Fitted_Model_4 , "Model: Log-Logistic" , c(-2.90509719095083, -3.22382968699211, 0.770460283795502) , c(3.79034439690537, 1.37987439309905, 9.29526839843571) ) - validate_model( AA$Fitted_Model_5 , "Model: Log-Probit" , c(-2.76563341583274, -2.03205435911903, 0.487681754992638) , c(4.65955128862954, 1.88253828334611, 12.0003951662748) ) - validate_model( AA$Fitted_Model_6 , "Model: Multistage" , c(-2.50756489338324, 0.0122508853947786, 8.85365951190481e-05) , c(8.12334001064301, 6.09589901365889, 11.2063977029104) ) - validate_model( AA$Fitted_Model_7 , "Model: Probit" , c(-1.22897249357605, 0.0286868893347652) , c(13.3264085482876, 10.9912280971799, 17.4597665445259) ) - validate_model( AA$Fitted_Model_8 , "Model: Quantal-Linear" , c(-2.45423133972787, 0.0132202483334582) , c(7.9696321128232, 5.93259065501385, 11.5959106855121) ) - validate_model( AA$Fitted_Model_9 , "Model: Weibull" , c(-2.86014800998383, 0.661116573139896, 0.0434668812243724) , c(3.81611266939088, 1.26068620197916, 9.68226547559964) ) + validate_model( AA$Individual_Model_1 , "Model: Hill" , c(-3.1514129532799, -0.542504910549596, -2.21526647189887, 1.38193548558345) , c(2.43689558842919, 1.19423317401394, 5.66302904194827) ) + validate_model( AA$Individual_Model_2 , "Model: Gamma" , c(-2.58597525196282, 0.859030175600515, 0.0103251850555099) , c(6.46707681632849, 2.71101742377789, 13.1872288945701) ) + validate_model( AA$Individual_Model_3 , "Model: Logistic" , c(-2.0069607207327, 0.0463222123387509) , c(14.2821369829316, 11.7611052273976, 18.9167440555661) ) + validate_model( AA$Individual_Model_4 , "Model: Log-Logistic" , c(-2.90509719095083, -3.22382968699211, 0.770460283795502) , c(3.79034439690537, 1.37987439309905, 9.29526839843571) ) + validate_model( AA$Individual_Model_5 , "Model: Log-Probit" , c(-2.76563341583274, -2.03205435911903, 0.487681754992638) , c(4.65955128862954, 1.88253828334611, 12.0003951662748) ) + validate_model( AA$Individual_Model_6 , "Model: Multistage" , c(-2.50756489338324, 0.0122508853947786, 8.85365951190481e-05) , c(8.12334001064301, 6.09589901365889, 11.2063977029104) ) + validate_model( AA$Individual_Model_7 , "Model: Probit" , c(-1.22897249357605, 0.0286868893347652) , c(13.3264085482876, 10.9912280971799, 17.4597665445259) ) + validate_model( AA$Individual_Model_8 , "Model: Quantal-Linear" , c(-2.45423133972787, 0.0132202483334582) , c(7.9696321128232, 5.93259065501385, 11.5959106855121) ) + validate_model( AA$Individual_Model_9 , "Model: Weibull" , c(-2.86014800998383, 0.661116573139896, 0.0434668812243724) , c(3.81611266939088, 1.26068620197916, 9.68226547559964) ) }) test_that("Vector Inputs", { @@ -33,20 +33,20 @@ test_that("Vector Inputs", { dim(N) <- c(nrow(mData),1) AA = ma_dichotomous_fit(D,Y,N) - expect_equal(c("BMDdichotomous_MA", "BMDdichotomous_MA_maximized"), class(AA)) + expect_equal(c("BMDdichotomous_MA", "BMDdichotomous_MA_laplace"), class(AA)) expect_equal(13, length(AA)) expect_equal(setNames(c(4.17, 1.33, 12.318), c("BMD", "BMDL", "BMDU")), AA$bmd, tolerance=10e-2) expect_equal(c(0.427802462, 0.021635893, 0.022796957, 0.109884198, 0.006866267, 0.001184459, 0.025631532, 0.291857962, 0.092340269), AA$posterior_probs, tolerance=10e-2) #generate_validation_code(AA) - validate_model( AA$Fitted_Model_1 , "Model: Hill" , c(-3.1514129532799, -0.542504910549596, -2.21526647189887, 1.38193548558345) , c(2.43689558842919, 1.19423317401394, 5.66302904194827) ) - validate_model( AA$Fitted_Model_2 , "Model: Gamma" , c(-2.58597525196282, 0.859030175600515, 0.0103251850555099) , c(6.46707681632849, 2.71101742377789, 13.1872288945701) ) - validate_model( AA$Fitted_Model_3 , "Model: Logistic" , c(-2.0069607207327, 0.0463222123387509) , c(14.2821369829316, 11.7611052273976, 18.9167440555661) ) - validate_model( AA$Fitted_Model_4 , "Model: Log-Logistic" , c(-2.90509719095083, -3.22382968699211, 0.770460283795502) , c(3.79034439690537, 1.37987439309905, 9.29526839843571) ) - validate_model( AA$Fitted_Model_5 , "Model: Log-Probit" , c(-2.76563341583274, -2.03205435911903, 0.487681754992638) , c(4.65955128862954, 1.88253828334611, 12.0003951662748) ) - validate_model( AA$Fitted_Model_6 , "Model: Multistage" , c(-2.50756489338324, 0.0122508853947786, 8.85365951190481e-05) , c(8.12334001064301, 6.09589901365889, 11.2063977029104) ) - validate_model( AA$Fitted_Model_7 , "Model: Probit" , c(-1.22897249357605, 0.0286868893347652) , c(13.3264085482876, 10.9912280971799, 17.4597665445259) ) - validate_model( AA$Fitted_Model_8 , "Model: Quantal-Linear" , c(-2.45423133972787, 0.0132202483334582) , c(7.9696321128232, 5.93259065501385, 11.5959106855121) ) - validate_model( AA$Fitted_Model_9 , "Model: Weibull" , c(-2.86014800998383, 0.661116573139896, 0.0434668812243724) , c(3.81611266939088, 1.26068620197916, 9.68226547559964) ) + validate_model( AA$Individual_Model_1 , "Model: Hill" , c(-3.1514129532799, -0.542504910549596, -2.21526647189887, 1.38193548558345) , c(2.43689558842919, 1.19423317401394, 5.66302904194827) ) + validate_model( AA$Individual_Model_2 , "Model: Gamma" , c(-2.58597525196282, 0.859030175600515, 0.0103251850555099) , c(6.46707681632849, 2.71101742377789, 13.1872288945701) ) + validate_model( AA$Individual_Model_3 , "Model: Logistic" , c(-2.0069607207327, 0.0463222123387509) , c(14.2821369829316, 11.7611052273976, 18.9167440555661) ) + validate_model( AA$Individual_Model_4 , "Model: Log-Logistic" , c(-2.90509719095083, -3.22382968699211, 0.770460283795502) , c(3.79034439690537, 1.37987439309905, 9.29526839843571) ) + validate_model( AA$Individual_Model_5 , "Model: Log-Probit" , c(-2.76563341583274, -2.03205435911903, 0.487681754992638) , c(4.65955128862954, 1.88253828334611, 12.0003951662748) ) + validate_model( AA$Individual_Model_6 , "Model: Multistage" , c(-2.50756489338324, 0.0122508853947786, 8.85365951190481e-05) , c(8.12334001064301, 6.09589901365889, 11.2063977029104) ) + validate_model( AA$Individual_Model_7 , "Model: Probit" , c(-1.22897249357605, 0.0286868893347652) , c(13.3264085482876, 10.9912280971799, 17.4597665445259) ) + validate_model( AA$Individual_Model_8 , "Model: Quantal-Linear" , c(-2.45423133972787, 0.0132202483334582) , c(7.9696321128232, 5.93259065501385, 11.5959106855121) ) + validate_model( AA$Individual_Model_9 , "Model: Weibull" , c(-2.86014800998383, 0.661116573139896, 0.0434668812243724) , c(3.81611266939088, 1.26068620197916, 9.68226547559964) ) }) test_that("Plots", { diff --git a/tests/testthat/test-single_dichotomous_laplace.R b/tests/testthat/test-single_dichotomous_laplace.R index c4400e8..51d9cbc 100644 --- a/tests/testthat/test-single_dichotomous_laplace.R +++ b/tests/testthat/test-single_dichotomous_laplace.R @@ -48,11 +48,11 @@ test_that("Plots", { laplace_plot <- plot(c) expect_identical(laplace_plot$labels$x, "Dose") expect_identical(laplace_plot$labels$y, "Proportion") - expect_identical(laplace_plot$labels$title, "Model: Hill, Fit Type: Maximized") + expect_identical(laplace_plot$labels$title, "Model: Hill") c = single_dichotomous_fit(mData[,1],mData[,2],mData[,3],model_type = "weibull", fit_type = "laplace") laplace_plot <- plot(c) expect_identical(laplace_plot$labels$x, "Dose") expect_identical(laplace_plot$labels$y, "Proportion") - expect_identical(laplace_plot$labels$title, "Model: Weibull, Fit Type: Maximized") + expect_identical(laplace_plot$labels$title, "Model: Weibull") }) \ No newline at end of file diff --git a/tests/testthat/test-single_dichotomous_mcmc.R b/tests/testthat/test-single_dichotomous_mcmc.R index 0b810df..61d6c2d 100644 --- a/tests/testthat/test-single_dichotomous_mcmc.R +++ b/tests/testthat/test-single_dichotomous_mcmc.R @@ -36,11 +36,11 @@ test_that("Plots", { expect_identical(mcmc_plot$labels$x, "Dose") expect_identical(mcmc_plot$labels$y, "Proportion") #TODO should the title have the distribution name? - expect_identical(mcmc_plot$labels$title, "Model: Weibull, Fit Type: MCMC") + expect_identical(mcmc_plot$labels$title, "Model: Weibull") c = single_dichotomous_fit(mData[,1],mData[,2],mData[,3],model_type = "hill", fit_type = "mcmc") mcmc_plot <- plot(c) expect_identical(mcmc_plot$labels$x, "Dose") expect_identical(mcmc_plot$labels$y, "Proportion") #TODO should the title have the distribution name? - expect_identical(mcmc_plot$labels$title, "Model: Hill, Fit Type: MCMC") + expect_identical(mcmc_plot$labels$title, "Model: Hill") }) \ No newline at end of file diff --git a/tests/testthat/test-single_dichotomous_mle_2.R b/tests/testthat/test-single_dichotomous_mle_2.R new file mode 100644 index 0000000..2512feb --- /dev/null +++ b/tests/testthat/test-single_dichotomous_mle_2.R @@ -0,0 +1,49 @@ +context("Single Dichotomous Models MLE") + +test_that("Hill Laplace", { + set.seed(5981) + mData <- build_single_dichotomous_dataset_2() + mData <- build_single_dichotomous_dataset_2() + c = single_dichotomous_fit(mData[,1],mData[,2],mData[,3], + model_type = "hill", fit_type = "laplace") + validate_model2(c, "Model: Hill", c(-1.673544, 3.459392, 5.833098, 1.462155), + c(0.004217370,0.001890691,0.007291542),c(6.54215815,0.01053297)) +}) + +test_that("Weibull Laplace", { + set.seed(5981) + mData <- build_single_dichotomous_dataset_2() + c = single_dichotomous_fit(mData[,1],mData[,2],mData[,3], + model_type = "weibull", fit_type = "laplace") + validate_model2(c, "Model: Weibull", c(-1.7686897,0.7951624,14.4332211), + c(0.0020553904,0.0007833962,0.0049656820 ),c(3.187 ,0.076)) +}) + +test_that("Weibull MLE", { + set.seed(5981) + mData <- build_single_dichotomous_dataset_2() + c = single_dichotomous_fit(mData[,1],mData[,2],mData[,3], + model_type = "weibull", fit_type = "mle") + validate_model2(c, "Model: Weibull", c(-1.8014517,0.7668152,13.6038641), + c(0.0017663444,0.0006435623,0.0044451057),c(2.986,0.084)) +}) + + +test_that("Gamma MLE", { + set.seed(5981) + mData <- build_single_dichotomous_dataset_2() + c = single_dichotomous_fit(mData[,1],mData[,2],mData[,3], + model_type = "gamma", fit_type = "mle") + validate_model2(c, "Model: Gamma", c(-1.671756,1.000000, 24.832283), + c(0.0020553904,0.0007833962,0.0049656820 ),c( 5.489 , 0.019)) +}) + +test_that("Gamma MLE", { + set.seed(5981) + mData <- build_single_dichotomous_dataset_2() + c = single_dichotomous_fit(mData[,1],mData[,2],mData[,3], + model_type = "gamma", fit_type = "laplace") + validate_model2(c, "Model: Gamma",c( -1.7531361,0.7512065,18.8926902), + c(0.004242885,0.003526430,0.006277881 ),c(3.125,0.085)) +}) + diff --git a/tests/testthat/testthat-problems.rds b/tests/testthat/testthat-problems.rds new file mode 100644 index 0000000..7086209 Binary files /dev/null and b/tests/testthat/testthat-problems.rds differ diff --git a/tools/cmake_call.sh b/tools/cmake_call.sh new file mode 100755 index 0000000..a631473 --- /dev/null +++ b/tools/cmake_call.sh @@ -0,0 +1,41 @@ +#! /bin/sh + + +: ${R_HOME=$(R RHOME)} +RSCRIPT_BIN=${R_HOME}/bin/Rscript +NCORES=`${RSCRIPT_BIN} -e "cat(min(2, parallel::detectCores(logical = FALSE)))"` + +cd src + +#### CMAKE CONFIGURATION #### +. ./scripts/cmake_config.sh + +# Compile NLOpt from source +sh ./scripts/nlopt_download.sh ${RSCRIPT_BIN} +dot() { file=$1; shift; . "$file"; } +dot ./scripts/r_config.sh "" +${RSCRIPT_BIN} --vanilla -e 'getRversion() > "4.0.0"' | grep TRUE > /dev/null +if [ $? -eq 0 ]; then + CMAKE_ADD_AR="-D CMAKE_AR=${AR}" + CMAKE_ADD_RANLIB="-D CMAKE_RANLIB=${RANLIB}" +else + CMAKE_ADD_AR="" + CMAKE_ADD_RANLIB="" +fi +${CMAKE_BIN} \ + -D BUILD_SHARED_LIBS=OFF \ + -D CMAKE_BUILD_TYPE=Release \ + -D INSTALL_LIB_DIR=nlopt/lib \ + -D NLOPT_CXX=ON \ + -D NLOPT_GUILE=OFF \ + -D NLOPT_MATLAB=OFF \ + -D NLOPT_OCTAVE=OFF \ + -D NLOPT_PYTHON=OFF \ + -D NLOPT_SWIG=OFF \ + -D NLOPT_TESTS=OFF \ + -S nlopt-src \ + -B nlopt-build ${CMAKE_ADD_AR} ${CMAKE_ADD_RANLIB} +sh ./scripts/nlopt_install.sh ${CMAKE_BIN} ${NCORES} "" + +# Cleanup +sh ./scripts/nlopt_cleanup.sh diff --git a/tools/winlibs.R b/tools/winlibs.R new file mode 100644 index 0000000..1efad65 --- /dev/null +++ b/tools/winlibs.R @@ -0,0 +1,7 @@ +# Build against mingw-w64 build of nlopt +if(!file.exists("../windows/nlopt-2.7.1/include/nlopt.hpp")){ + download.file("https://github.com/rwinlib/nlopt/archive/v2.7.1.zip", "lib.zip", quiet = TRUE) + dir.create("../windows", showWarnings = FALSE) + unzip("lib.zip", exdir = "../windows") + unlink("lib.zip") +} diff --git a/vignettes/Continuous.Rmd b/vignettes/Continuous.Rmd index 0f92432..89c6f14 100755 --- a/vignettes/Continuous.Rmd +++ b/vignettes/Continuous.Rmd @@ -1,28 +1,15 @@ --- title: "Continuous Data Example" author: "Matt Wheeler Ph.D." -date: "2/15/2021" -#bibliography: "biblo.bib" +date: "2/15/2022" output: rmarkdown::html_vignette vignette: > - %\VignetteIndexEntry{Continuous} + %\VignetteIndexEntry{ToxicR: Continuous Analysis} %\VignetteEngine{knitr::rmarkdown} %\VignetteEncoding{UTF-8} -#output: -# html_document: -# bibliography: "biblo.bib" -# toc: yes -# toc_float: yes -# word_document: -# bibliography: "biblo.bib" -# toc: yes -# pdf_document: -# bibliography: "biblo.bib" -# toc: yes --- ```{r setup, include=FALSE} -library(bibtex) knitr::opts_chunk$set( echo = TRUE, collapse = TRUE, diff --git a/vignettes/Continuous_files/.DS_Store b/vignettes/Continuous_files/.DS_Store deleted file mode 100644 index 1156b7e..0000000 Binary files a/vignettes/Continuous_files/.DS_Store and /dev/null differ diff --git a/vignettes/Continuous_files/figure-gfm/run_laplace_MA-1.png b/vignettes/Continuous_files/figure-gfm/run_laplace_MA-1.png deleted file mode 100644 index 19f4a2b..0000000 Binary files a/vignettes/Continuous_files/figure-gfm/run_laplace_MA-1.png and /dev/null differ diff --git a/vignettes/Continuous_files/figure-gfm/run_laplace_MA-2.png b/vignettes/Continuous_files/figure-gfm/run_laplace_MA-2.png deleted file mode 100644 index 3c50e90..0000000 Binary files a/vignettes/Continuous_files/figure-gfm/run_laplace_MA-2.png and /dev/null differ diff --git a/vignettes/Continuous_files/figure-gfm/run_laplace_MA-3.png b/vignettes/Continuous_files/figure-gfm/run_laplace_MA-3.png deleted file mode 100644 index bac919d..0000000 Binary files a/vignettes/Continuous_files/figure-gfm/run_laplace_MA-3.png and /dev/null differ diff --git a/vignettes/Continuous_files/figure-gfm/run_laplace_MA_3-1.png b/vignettes/Continuous_files/figure-gfm/run_laplace_MA_3-1.png deleted file mode 100644 index dbaf3c5..0000000 Binary files a/vignettes/Continuous_files/figure-gfm/run_laplace_MA_3-1.png and /dev/null differ diff --git a/vignettes/Continuous_files/figure-gfm/run_laplace_cprior2-1.png b/vignettes/Continuous_files/figure-gfm/run_laplace_cprior2-1.png deleted file mode 100644 index d57d601..0000000 Binary files a/vignettes/Continuous_files/figure-gfm/run_laplace_cprior2-1.png and /dev/null differ diff --git a/vignettes/Continuous_files/figure-gfm/run_laplace_exp5-1.png b/vignettes/Continuous_files/figure-gfm/run_laplace_exp5-1.png deleted file mode 100644 index 86f5faa..0000000 Binary files a/vignettes/Continuous_files/figure-gfm/run_laplace_exp5-1.png and /dev/null differ diff --git a/vignettes/Continuous_files/figure-gfm/run_laplace_hill3-1.png b/vignettes/Continuous_files/figure-gfm/run_laplace_hill3-1.png deleted file mode 100644 index 450e781..0000000 Binary files a/vignettes/Continuous_files/figure-gfm/run_laplace_hill3-1.png and /dev/null differ diff --git a/vignettes/Continuous_files/figure-gfm/run_laplace_hillad-1.png b/vignettes/Continuous_files/figure-gfm/run_laplace_hillad-1.png deleted file mode 100644 index aa6f60f..0000000 Binary files a/vignettes/Continuous_files/figure-gfm/run_laplace_hillad-1.png and /dev/null differ diff --git a/vignettes/Continuous_files/figure-gfm/run_laplace_hillhybrid-1.png b/vignettes/Continuous_files/figure-gfm/run_laplace_hillhybrid-1.png deleted file mode 100644 index 48dece6..0000000 Binary files a/vignettes/Continuous_files/figure-gfm/run_laplace_hillhybrid-1.png and /dev/null differ diff --git a/vignettes/Continuous_files/figure-gfm/run_laplace_hillrd-1.png b/vignettes/Continuous_files/figure-gfm/run_laplace_hillrd-1.png deleted file mode 100644 index cfc3b27..0000000 Binary files a/vignettes/Continuous_files/figure-gfm/run_laplace_hillrd-1.png and /dev/null differ diff --git a/vignettes/Continuous_files/figure-gfm/run_laplace_hillsd-1.png b/vignettes/Continuous_files/figure-gfm/run_laplace_hillsd-1.png deleted file mode 100644 index 10c73ea..0000000 Binary files a/vignettes/Continuous_files/figure-gfm/run_laplace_hillsd-1.png and /dev/null differ diff --git a/vignettes/Continuous_files/figure-gfm/run_laplace_polynomial-1.png b/vignettes/Continuous_files/figure-gfm/run_laplace_polynomial-1.png deleted file mode 100644 index 5717b06..0000000 Binary files a/vignettes/Continuous_files/figure-gfm/run_laplace_polynomial-1.png and /dev/null differ diff --git a/vignettes/Dichotomous.Rmd b/vignettes/Dichotomous.Rmd index 35623b4..ccb5385 100755 --- a/vignettes/Dichotomous.Rmd +++ b/vignettes/Dichotomous.Rmd @@ -7,14 +7,6 @@ vignette: > %\VignetteIndexEntry{Dichotomous} %\VignetteEngine{knitr::rmarkdown} %\VignetteEncoding{UTF-8} -# output: - # html_document: - # toc: yes - # toc_float: yes - # word_document: - # toc: yes - # pdf_document: - # toc: yes --- ```{r setup, include=FALSE} @@ -27,7 +19,6 @@ This file shows ToxicR for dichotomous benchmark dose analyses using both single ```{r load_data, echo=TRUE} -library(readxl) dich_data <- matrix(0,nrow=5,ncol=3) colnames(dich_data) <- c("Dose","N","Incidence") dich_data[,1] <- c(0,50,100,200,400)