Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Jump to bottom

add R package #53

Draft
wants to merge 6 commits into
base: main
Choose a base branch
from
Draft

add R package #53

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
6 commits
Select commit Hold shift + click to select a range
d47d32a
uncomment bmds entry.h to allow R package to compile/install
munnsmunns Aug 13, 2024
db3ede9
add a function to main_entry from BMDS helper
munnsmunns Sep 3, 2024
49ee8b6
add bmds version of dichotomous analysis
munnsmunns Sep 10, 2024
024de81
change function name
munnsmunns Sep 10, 2024
5f64e79
adjust bmds wrapper function
munnsmunns Sep 13, 2024
84a3768
test dichotomous function
munnsmunns Sep 13, 2024
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
4 changes: 4 additions & 0 deletions R/RcppExports.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -9,6 +9,10 @@
.Call(`_ToxicR_run_continuous_single`, model, Y, X, prior, options, dist_type)
}

run_bmds_dichotomous_analysis <- function(D, Y, N, BMD_type, BMR, alpha, parms, model, n, prior, prior_cols, degree) {
.Call(`_ToxicR_run_bmds_dichotomous_analysis`, D, Y, N, BMD_type, BMR, alpha, parms, model, n, prior, prior_cols, degree)
}

.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)
}
Expand Down
7 changes: 4 additions & 3 deletions R/dichotomous_wrappers.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -109,7 +109,7 @@ 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);
temp = .run_continuous_single(dmodel,DATA,bounds,o1,o2);
#class(temp$bmd_dist) <- "BMD_CDF"
temp_me = temp$bmd_dist

Expand All @@ -130,7 +130,8 @@ 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);
# replace original function call with new bmds function call
temp = .run_continuous_single(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))
Expand All @@ -141,7 +142,7 @@ 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_continuous_single(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))
Expand Down
9 changes: 9 additions & 0 deletions R/test_bmds.R
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -0,0 +1,9 @@
test_dichotomous <- function() {
Copy link
Collaborator Author

@munnsmunns munnsmunns Sep 13, 2024 •
edited
Loading

Choose a reason for hiding this comment

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

We're getting the right outputs from this!

> ToxicR::test_dichotomous()
$bmd
[1] 44.88413

$bmd_dist
  [1]     0.00000     0.00000     0.00000     0.00000    30.02733    30.60007
  [7]    31.08700    31.51878    31.90691    32.26039    32.58845    32.89301
 [13]    33.17977    33.45031    33.70602    33.95151    34.18506    34.40905
 [19]    34.62602    34.83443    35.03558    35.23136    35.42149    35.60557
 [25]    35.78479    35.96032    36.13162    36.29845    36.46161    36.62187
 [31]    36.77958    36.93393    37.08528    37.23407    37.38077    37.52547
 . . .

Copy link
Collaborator

Choose a reason for hiding this comment

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

this is perfect! the example script is exactly what I was hoping might be possible. Nice job.

D = c(0.0, 25.0, 75.0, 125.0, 200.0)
Y = c(0.0, 1.0, 7.0, 15.0, 19.0)
N = c(20.0, 20.0, 20.0, 20.0, 20.0)
prior = c(0.0, 0.0, 0.0, 0.0, 0.0, 0.0, -18.0, 0.0, 18.0, 100.0)
result = run_bmds_dichotomous_analysis(D,Y,N,BMD_type=1, BMR=0.1, alpha=0.05, parms=2, model=3, n=5, prior=prior, prior_cols=5, degree=0)

return(result)
}
24 changes: 24 additions & 0 deletions src/RcppExports.cpp
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -2,6 +2,7 @@
// Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393

#include <RcppEigen.h>
#include <RcppGSL.h>
#include <Rcpp.h>

using namespace Rcpp;
Expand Down Expand Up @@ -42,6 +43,28 @@ BEGIN_RCPP
return rcpp_result_gen;
END_RCPP
}
// run_bmds_dichotomous_analysis
List run_bmds_dichotomous_analysis(NumericVector D, NumericVector Y, NumericVector N, int BMD_type, double BMR, double alpha, int parms, int model, int n, NumericVector prior, int prior_cols, int degree);
RcppExport SEXP _ToxicR_run_bmds_dichotomous_analysis(SEXP DSEXP, SEXP YSEXP, SEXP NSEXP, SEXP BMD_typeSEXP, SEXP BMRSEXP, SEXP alphaSEXP, SEXP parmsSEXP, SEXP modelSEXP, SEXP nSEXP, SEXP priorSEXP, SEXP prior_colsSEXP, SEXP degreeSEXP) {
BEGIN_RCPP
Rcpp::RObject rcpp_result_gen;
Rcpp::RNGScope rcpp_rngScope_gen;
Rcpp::traits::input_parameter< NumericVector >::type D(DSEXP);
Rcpp::traits::input_parameter< NumericVector >::type Y(YSEXP);
Rcpp::traits::input_parameter< NumericVector >::type N(NSEXP);
Rcpp::traits::input_parameter< int >::type BMD_type(BMD_typeSEXP);
Rcpp::traits::input_parameter< double >::type BMR(BMRSEXP);
Rcpp::traits::input_parameter< double >::type alpha(alphaSEXP);
Rcpp::traits::input_parameter< int >::type parms(parmsSEXP);
Rcpp::traits::input_parameter< int >::type model(modelSEXP);
Rcpp::traits::input_parameter< int >::type n(nSEXP);
Rcpp::traits::input_parameter< NumericVector >::type prior(priorSEXP);
Rcpp::traits::input_parameter< int >::type prior_cols(prior_colsSEXP);
Rcpp::traits::input_parameter< int >::type degree(degreeSEXP);
rcpp_result_gen = Rcpp::wrap(run_bmds_dichotomous_analysis(D, Y, N, BMD_type, BMR, alpha, parms, model, n, prior, prior_cols, degree));
return rcpp_result_gen;
END_RCPP
}
// run_continuous_ma_laplace
List run_continuous_ma_laplace(List model_priors, NumericVector model_type, NumericVector dist_type, Eigen::MatrixXd Y, Eigen::MatrixXd X, NumericVector options);
RcppExport SEXP _ToxicR_run_continuous_ma_laplace(SEXP model_priorsSEXP, SEXP model_typeSEXP, SEXP dist_typeSEXP, SEXP YSEXP, SEXP XSEXP, SEXP optionsSEXP) {
Expand Down Expand Up @@ -140,6 +163,7 @@ END_RCPP
static const R_CallMethodDef CallEntries[] = {
{"_ToxicR_run_single_dichotomous", (DL_FUNC) &_ToxicR_run_single_dichotomous, 5},
{"_ToxicR_run_continuous_single", (DL_FUNC) &_ToxicR_run_continuous_single, 6},
{"_ToxicR_run_bmds_dichotomous_analysis", (DL_FUNC) &_ToxicR_run_bmds_dichotomous_analysis, 12},
{"_ToxicR_run_continuous_ma_laplace", (DL_FUNC) &_ToxicR_run_continuous_ma_laplace, 6},
{"_ToxicR_run_continuous_ma_mcmc", (DL_FUNC) &_ToxicR_run_continuous_ma_mcmc, 6},
{"_ToxicR_run_ma_dichotomous", (DL_FUNC) &_ToxicR_run_ma_dichotomous, 7},
Expand Down
Loading