-
Notifications
You must be signed in to change notification settings - Fork 6
/
RcppExports.R
895 lines (791 loc) · 25 KB
/
RcppExports.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
# Generated by using Rcpp::compileAttributes() -> do not edit by hand
# Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393
removableDrive <- function(driveRoot) {
.Call(`_rxode2_removableDrive`, driveRoot)
}
#' Scaled Inverse Chi Squared distribution
#'
#' @param n Number of random samples
#'
#' @param nu degrees of freedom of inverse chi square
#'
#' @param scale Scale of inverse chi squared distribution
#' (default is 1).
#'
#' @return a vector of inverse chi squared deviates.
#'
#' @examples
#' rinvchisq(3, 4, 1) ## Scale = 1, degrees of freedom = 4
#' rinvchisq(2, 4, 2) ## Scale = 2, degrees of freedom = 4
#' @export
rinvchisq <- function(n = 1L, nu = 1.0, scale = 1) {
.Call(`_rxode2_rinvchisq`, n, nu, scale)
}
#' One correlation sample from the LKJ distribution
#'
#' @param d The dimension of the correlation matrix
#'
#' @param eta The scaling parameter of the LKJ distribution.
#' Must be > 1. Also related to the degrees of freedom nu.
#' eta = (nu-1)/2.
#'
#' @param cholesky boolean; If `TRUE` return the cholesky
#' decomposition.
#'
#' @return A correlation sample from the LKJ distribution
#'
#' @author Matthew Fidler (translated to RcppArmadillo) and Emma Schwager
#' @export
#' @keywords internal
rLKJ1 <- function(d, eta = 1.0, cholesky = FALSE) {
.Call(`_rxode2_rLKJ1`, d, eta, cholesky)
}
rLKJcv1 <- function(sd, eta = 1.0) {
.Call(`_rxode2_rLKJcv1`, sd, eta)
}
rLKJcvLsd1 <- function(logSd, logSdSD, eta = 1.0) {
.Call(`_rxode2_rLKJcvLsd1`, logSd, logSdSD, eta)
}
#' One correlation sample from the Inverse Wishart distribution
#'
#' This correlation is constructed by transformation of the Inverse Wishart
#' random covariate to a correlation.
#'
#' @inheritParams rLKJ1
#'
#' @param nu Degrees of freedom of the Wishart distribution
#'
#' @inheritParams cvPost
#'
#' @return One correlation sample from the inverse wishart
#'
#' @author Matthew Fidler
#' @keywords internal
#' @export
invWR1d <- function(d, nu, omegaIsChol = FALSE) {
.Call(`_rxode2_invWR1d`, d, nu, omegaIsChol)
}
rcvC1 <- function(sdEst, nu = 3.0, diagXformType = 1L, rType = 1L, returnChol = FALSE) {
.Call(`_rxode2_rcvC1`, sdEst, nu, diagXformType, rType, returnChol)
}
cvPost_ <- function(nuS, omegaS, nS, omegaIsCholS, returnCholS, typeS, diagXformTypeS) {
.Call(`_rxode2_cvPost_`, nuS, omegaS, nS, omegaIsCholS, returnCholS, typeS, diagXformTypeS)
}
expandTheta_ <- function(thetaS, thetaMatS, thetaLowerS, thetaUpperS, nStudS, nCoresRVS) {
.Call(`_rxode2_expandTheta_`, thetaS, thetaMatS, thetaLowerS, thetaUpperS, nStudS, nCoresRVS)
}
expandPars_ <- function(objectS, paramsS, eventsS, controlS) {
.Call(`_rxode2_expandPars_`, objectS, paramsS, eventsS, controlS)
}
nestingInfo_ <- function(omega, data) {
.Call(`_rxode2_nestingInfo_`, omega, data)
}
etDollarNames <- function(obj) {
.Call(`_rxode2_etDollarNames`, obj)
}
etUpdate <- function(obj, arg = NULL, value = NULL, exact = TRUE) {
.Call(`_rxode2_etUpdate`, obj, arg, value, exact)
}
et_ <- function(input, et__) {
.Call(`_rxode2_et_`, input, et__)
}
etSeq_ <- function(ets, handleSamples = 0L, waitType = 0L, defaultIi = 0, rbind = FALSE, uniqueId = 0L, reserveLen = 0L, needSort = TRUE, newUnits = as.character( c()), newShow = as.logical( c()), isCmtIntIn = FALSE) {
.Call(`_rxode2_etSeq_`, ets, handleSamples, waitType, defaultIi, rbind, uniqueId, reserveLen, needSort, newUnits, newShow, isCmtIntIn)
}
etRep_ <- function(curEt, times, wait, ids, handleSamples, waitType, ii) {
.Call(`_rxode2_etRep_`, curEt, times, wait, ids, handleSamples, waitType, ii)
}
#' Force using base order for rxode2 radix sorting
#'
#' @param forceBase boolean indicating if rxode2 should use R's
#' [order()] for radix sorting instead of
#' `data.table`'s parallel radix sorting.
#'
#' @return NILL; called for side effects
#'
#' @examples
#' \donttest{
#' forderForceBase(TRUE) # Use base `order` for rxode2 sorts
#' forderForceBase(FALSE) # Use `data.table` for rxode2 sorts
#' }
#' @export
#' @keywords internal
forderForceBase <- function(forceBase = FALSE) {
.Call(`_rxode2_forderForceBase`, forceBase)
}
#' Set Initial conditions to time zero instead of the first observed/dosed time
#'
#' @param ini0 When `TRUE` (default), set initial conditions to time
#' zero. Otherwise the initial conditions are the first observed
#' time.
#'
#' @return the boolean ini0, though this is called for its side effects
#'
#' @export
rxSetIni0 <- function(ini0 = TRUE) {
.Call(`_rxode2_rxSetIni0`, ini0)
}
#' Event translation for rxode2
#'
#' @param inData Data frame to translate
#'
#' @param obj Model to translate data
#'
#' @param addCmt Add compartment to data frame (default `FALSE`).
#'
#' @param dropUnits Boolean to drop the units (default `FALSE`).
#'
#' @param allTimeVar Treat all covariates as if they were time-varying
#'
#' @param keepDosingOnly keep the individuals who only have dosing records and any
#' trailing dosing records after the last observation.
#'
#' @param combineDvid is a boolean indicating if rxode2 will use `DVID` on observation
#' records to change the `cmt` value; Useful for multiple-endpoint nlmixr models. By default
#' this is determined by `option("rxode2.combine.dvid")` and if the option has not been set,
#' this is `TRUE`. This typically does not affect rxode2 simulations.
#'
#' @param keep This is a named vector of items you want to keep in the final rxode2 dataset.
#' For added rxode2 event records (if seen), last observation carried forward will be used.
#'
#' @return Object for solving in rxode2
#'
#' @keywords internal
#'
#' @export
etTrans <- function(inData, obj, addCmt = FALSE, dropUnits = FALSE, allTimeVar = FALSE, keepDosingOnly = FALSE, combineDvid = NULL, keep = character(0)) {
.Call(`_rxode2_etTrans`, inData, obj, addCmt, dropUnits, allTimeVar, keepDosingOnly, combineDvid, keep)
}
#' Expand grid internal function
#'
#' @param c1 character vector of items to be expanded
#' @param c2 second character vector of items to be expanded
#' @param type 0 for a typical data frame, 1 for symengine sensitivity expansion
#' @export
#' @keywords internal
rxExpandGrid_ <- function(c1, c2, type) {
.Call(`_rxode2_rxExpandGrid_`, c1, c2, type)
}
#' Expand sensitivity
#'
#' @param state is the state to expand
#' @param calcSens is the variables to calculate sensitivity
#' @keywords internal
#' @export
rxExpandSens_ <- function(state, calcSens) {
.Call(`_rxode2_rxExpandSens_`, state, calcSens)
}
#' Expand second order sensitivity
#'
#' @param state is the state to expand
#' @param s1 is the variables to calculate sensitivity
#' @param s2 is the variables to calculate second order sensitivity
#' @keywords internal
#' @export
rxExpandSens2_ <- function(state, s1, s2) {
.Call(`_rxode2_rxExpandSens2_`, state, s1, s2)
}
#' Expand d(f)/d(eta)
#'
#' @param state is the state to expand
#' @param neta is the number of etas
#' @param pred type of prediction
#' @keywords internal
#' @export
rxExpandFEta_ <- function(state, neta, pred) {
.Call(`_rxode2_rxExpandFEta_`, state, neta, pred)
}
#' Rep R0 for foce
#'
#' @param number ETA to substitute
#'
#' @return Returns a string of R code to substitute the rx_r expression in the symengine environment .s
#'
#' @keywords internal
#'
#' @export
rxRepR0_ <- function(neta) {
.Call(`_rxode2_rxRepR0_`, neta)
}
rxExpandNesting <- function(obj, nestingInfo, compile = FALSE) {
.Call(`_rxode2_rxExpandNesting`, obj, nestingInfo, compile)
}
#' Inductive linearization solver
#'
#' @param cSub = Current subject number
#' @param op - rxode2 solving options
#' @param tp - Prior time point/time zeor
#' @param yp - Prior state; vector size = neq; Final state is updated here
#' @param tf - Final Time
#' @param InfusionRate = Rates of each comparment; vector size = neq
#' @param on Indicator for if the compartment is "on"
#' @param cache
#' 0 = no Cache
#' When doIndLin == 0, cache > 0 = nInf-1
#' @param ME the rxode2 matrix exponential function
#' @param IndF The rxode2 Inductive Linearization function F
#'
#' @return Returns a status for solving
#'
#' 1 = Successful solve
#'
#' -1 = Maximum number of iterations reached when doing
#' inductive linearization
NULL
rxIndLin_ <- function(states) {
.Call(`_rxode2_rxIndLin_`, states)
}
convertId_ <- function(x) {
.Call(`_rxode2_convertId_`, x)
}
rxQs <- function(x) {
.Call(`_rxode2_rxQs`, x)
}
rxQr <- function(encoded_string) {
.Call(`_rxode2_rxQr`, encoded_string)
}
#' Check the type of an object using Rcpp
#'
#' @param obj Object to check
#' @param cls Type of class. Only s3 classes for lists/environments and primitive classes are checked.
#' For matrix types they are distinguished as `numeric.matrix`, `integer.matrix`,
#' `logical.matrix`, and `character.matrix` as well as the traditional `matrix`
#' class. Additionally checks for `event.data.frame` which is an `data.frame` object
#' with `time`, `evid` and `amt`. (UPPER, lower or Title cases accepted)
#'
#' @return A boolean indicating if the object is a member of the class.
#'
#' @keywords internal
#'
#' @author Matthew L. Fidler
#'
#' @export
#'
rxIs <- function(obj, cls) {
.Call(`_rxode2_rxIs`, obj, cls)
}
getRxFn <- function(name) {
.Call(`_rxode2_getRxFn`, name)
}
dynLoad <- function(dll) {
.Call(`_rxode2_dynLoad`, dll)
}
rxModelVars_ <- function(obj) {
.Call(`_rxode2_rxModelVars_`, obj)
}
#' State variables
#'
#' This returns the model's compartments or states.
#'
#' @inheritParams rxModelVars
#'
#' @param state is a string indicating the state or compartment that
#' you would like to lookup.
#'
#' @return If state is missing, return a character vector of all the states.
#'
#' If state is a string, return the compartment number of the named state.
#'
#' @seealso [rxode2()]
#'
#' @author Matthew L.Fidler
#'
#' @export
rxState <- function(obj = NULL, state = NULL) {
.Call(`_rxode2_rxState`, obj, state)
}
rxParams_ <- function(obj) {
.Call(`_rxode2_rxParams_`, obj)
}
#' Jacobian and parameter derivatives
#'
#' Return Jacobain and parameter derivatives
#'
#' @inheritParams rxModelVars
#'
#' @return A list of the jacobian parameters defined in this rxode2
#' object.
#'
#' @author Matthew L. Fidler
#'
#' @export
rxDfdy <- function(obj) {
.Call(`_rxode2_rxDfdy`, obj)
}
#' Left handed Variables
#'
#' This returns the model calculated variables
#'
#' @inheritParams rxModelVars
#'
#' @return a character vector listing the calculated parameters
#' @seealso \code{\link{rxode2}}
#'
#' @author Matthew L.Fidler
#' @export
rxLhs <- function(obj) {
.Call(`_rxode2_rxLhs`, obj)
}
#' Initial Values and State values for a rxode2 object
#'
#' Returns the initial values of the rxDll object
#'
#' @param obj rxDll, rxode2, or named vector representing default
#' initial arguments
#'
#' @param vec If supplied, named vector for the model.
#'
#' @param req Required names, and the required order for the ODE solver
#'
#' @param defaultValue a number or NA representing the default value for
#' parameters missing in `vec`, but required in `req`.
#'
#' @param noerror is a boolean specifying if an error should be thrown
#' for missing parameter values when `default` = `NA`
#'
#' @return Initial values of the rxDll object
#'
#' @keywords internal
#' @author Matthew L.Fidler
#' @export
rxInits <- function(obj, vec = NULL, req = NULL, defaultValue = 0, noerror = FALSE, noini = FALSE, rxLines = FALSE) {
.Call(`_rxode2_rxInits`, obj, vec, req, defaultValue, noerror, noini, rxLines)
}
#' Setup the initial conditions.
#'
#' @param obj rxode2 object
#' @param inits A numeric vector of initial conditions.
#' @return initial conditions that were setup
#' @author Matthew L. Fidler
#' @keywords internal
#' @export
rxSetupIni <- function(obj, inits = NULL) {
.Call(`_rxode2_rxSetupIni`, obj, inits)
}
#' Setup the initial conditions.
#'
#' @param obj rxode2 object
#'
#' @param inits A numeric vector of initial conditions.
#'
#' @param extraArgs A list of extra args to parse for initial conditions.
#'
#' @author Matthew L. Fidler
#'
#' @keywords internal
#'
#' @return setup scale for changing compartment values
#'
#' @export
rxSetupScale <- function(obj, scale = NULL, extraArgs = NULL) {
.Call(`_rxode2_rxSetupScale`, obj, scale, extraArgs)
}
atolRtolFactor_ <- function(factor) {
invisible(.Call(`_rxode2_atolRtolFactor_`, factor))
}
#' Simulate Parameters from a Theta/Omega specification
#'
#' @param params Named Vector of rxode2 model parameters
#'
#' @param nObs Number of observations to simulate (with `sigma` matrix)
#'
#' @inheritParams rxSolve
#'
#' @param simSubjects boolean indicated rxode2 should simulate subjects in studies (`TRUE`,
#' default) or studies (`FALSE`)
#'
#' @return a data frame with the simulated subjects
#'
#' @author Matthew L.Fidler
#'
#' @export
rxSimThetaOmega <- function(params = NULL, omega = NULL, omegaDf = NULL, omegaLower = as.numeric( c(R_NegInf)), omegaUpper = as.numeric( c(R_PosInf)), omegaIsChol = FALSE, omegaSeparation = "auto", omegaXform = 1L, nSub = 1L, thetaMat = NULL, thetaLower = as.numeric( c(R_NegInf)), thetaUpper = as.numeric( c(R_PosInf)), thetaDf = NULL, thetaIsChol = FALSE, nStud = 1L, sigma = NULL, sigmaLower = as.numeric( c(R_NegInf)), sigmaUpper = as.numeric( c(R_PosInf)), sigmaDf = NULL, sigmaIsChol = FALSE, sigmaSeparation = "auto", sigmaXform = 1L, nCoresRV = 1L, nObs = 1L, dfSub = 0, dfObs = 0, simSubjects = TRUE) {
.Call(`_rxode2_rxSimThetaOmega`, params, omega, omegaDf, omegaLower, omegaUpper, omegaIsChol, omegaSeparation, omegaXform, nSub, thetaMat, thetaLower, thetaUpper, thetaDf, thetaIsChol, nStud, sigma, sigmaLower, sigmaUpper, sigmaDf, sigmaIsChol, sigmaSeparation, sigmaXform, nCoresRV, nObs, dfSub, dfObs, simSubjects)
}
#' Free the C solving/parsing information.
#'
#' Take the ODE C system and free it.
#'
#' @keywords internal
#' @return logical indicating if the memory was successfully freed
#' @export
rxSolveFree <- function() {
.Call(`_rxode2_rxSolveFree`)
}
rxSolve_ <- function(obj, rxControl, specParams, extraArgs, params, events, inits, setupOnly) {
.Call(`_rxode2_rxSolve_`, obj, rxControl, specParams, extraArgs, params, events, inits, setupOnly)
}
rxSolveDollarNames <- function(obj) {
.Call(`_rxode2_rxSolveDollarNames`, obj)
}
rxSolveGet <- function(obj, arg, exact = TRUE) {
.Call(`_rxode2_rxSolveGet`, obj, arg, exact)
}
rxSolveUpdate <- function(obj, arg = NULL, value = NULL) {
.Call(`_rxode2_rxSolveUpdate`, obj, arg, value)
}
rxSolveSEXP <- function(objS, rxControlS, specParamsS, extraArgsS, paramsS, eventsS, initsS, setupOnlyS) {
.Call(`_rxode2_rxSolveSEXP`, objS, rxControlS, specParamsS, extraArgsS, paramsS, eventsS, initsS, setupOnlyS)
}
rxRmModelLib_ <- function(str) {
invisible(.Call(`_rxode2_rxRmModelLib_`, str))
}
#' Get rxode2 model from object
#' @param obj rxode2 family of objects
#' @return rxode2 model
#' @export
rxGetrxode2 <- function(obj) {
.Call(`_rxode2_rxGetrxode2`, obj)
}
#' Checks if the rxode2 object was built with the current build
#'
#' @inheritParams rxModelVars
#'
#' @return boolean indicating if this was built with current rxode2
#'
#' @export
rxIsCurrent <- function(obj) {
.Call(`_rxode2_rxIsCurrent`, obj)
}
#' Assign pointer based on model variables
#' @param object rxode2 family of objects
#' @return nothing, called for side effects
#' @export
rxAssignPtr <- function(object = NULL) {
invisible(.Call(`_rxode2_rxAssignPtr`, object))
}
#' Return the DLL associated with the rxode2 object
#'
#' This will return the dynamic load library or shared object used to
#' run the C code for rxode2.
#'
#' @param obj A rxode2 family of objects or a character string of the
#' model specification or location of a file with a model
#' specification.
#'
#' @return a path of the library
#'
#' @keywords internal
#' @author Matthew L.Fidler
#' @export
rxDll <- function(obj) {
.Call(`_rxode2_rxDll`, obj)
}
#' Return the C file associated with the rxode2 object
#'
#' This will return C code for generating the rxode2 DLL.
#'
#' @param obj A rxode2 family of objects or a character string of the
#' model specification or location of a file with a model
#' specification.
#'
#' @return a path of the library
#'
#' @keywords internal
#' @author Matthew L.Fidler
#' @export
rxC <- function(obj) {
.Call(`_rxode2_rxC`, obj)
}
#' Determine if the DLL associated with the rxode2 object is loaded
#'
#' @param obj A rxode2 family of objects
#'
#' @return Boolean returning if the rxode2 library is loaded.
#'
#' @keywords internal
#' @author Matthew L.Fidler
#' @export
rxIsLoaded <- function(obj) {
.Call(`_rxode2_rxIsLoaded`, obj)
}
#' Load rxode2 object
#'
#' @param obj A rxode2 family of objects
#'
#' @return Boolean returning if the rxode2 library is loaded.
#'
#' @keywords internal
#' @author Matthew L.Fidler
#' @export
rxDynLoad <- function(obj) {
.Call(`_rxode2_rxDynLoad`, obj)
}
#' Lock/unlocking of rxode2 dll file
#'
#' @param obj A rxode2 family of objects
#'
#' @return nothing; called for side effects
#'
#' @export
rxLock <- function(obj) {
.Call(`_rxode2_rxLock`, obj)
}
#' @rdname rxLock
#' @export
rxUnlock <- function(obj) {
.Call(`_rxode2_rxUnlock`, obj)
}
#' Allow unloading of dlls
#'
#' @param allow boolean indicating if garbage collection will unload of rxode2 dlls.
#'
#' @return Boolean allow; called for side effects
#'
#' @examples
#'
#' # Garbage collection will not unload un-used rxode2 dlls
#' rxAllowUnload(FALSE);
#'
#' # Garbage collection will unload unused rxode2 dlls
#' rxAllowUnload(TRUE);
#' @export
#' @author Matthew Fidler
rxAllowUnload <- function(allow) {
.Call(`_rxode2_rxAllowUnload`, allow)
}
rxUnloadAll_ <- function() {
.Call(`_rxode2_rxUnloadAll_`)
}
#' Unload rxode2 object
#'
#' @param obj A rxode2 family of objects
#'
#' @return Boolean returning if the rxode2 library is loaded.
#'
#' @keywords internal
#' @author Matthew L.Fidler
#' @export
rxDynUnload <- function(obj) {
.Call(`_rxode2_rxDynUnload`, obj)
}
#' Delete the DLL for the model
#'
#' This function deletes the DLL, but doesn't delete the model
#' information in the object.
#'
#' @param obj rxode2 family of objects
#'
#' @return A boolean stating if the operation was successful.
#'
#' @author Matthew L.Fidler
#' @export
rxDelete <- function(obj) {
.Call(`_rxode2_rxDelete`, obj)
}
setRstudio <- function(isRstudio = FALSE) {
.Call(`_rxode2_setRstudio`, isRstudio)
}
setProgSupported <- function(isSupported = 1L) {
.Call(`_rxode2_setProgSupported`, isSupported)
}
getProgSupported <- function() {
.Call(`_rxode2_getProgSupported`)
}
rxUpdateTrans_ <- function(ret, prefix, libName) {
.Call(`_rxode2_rxUpdateTrans_`, ret, prefix, libName)
}
dropUnitsRxSolve <- function(x) {
.Call(`_rxode2_dropUnitsRxSolve`, x)
}
#' Silence some of rxode2's C/C++ messages
#'
#' @param silent can be 0L "noisy" or 1L "silent"
#'
#' @keywords internal
#' @return TRUE; called for side effects
#' @export
rxSetSilentErr <- function(silent) {
.Call(`_rxode2_rxSetSilentErr`, silent)
}
#' Invert matrix using RcppArmadillo.
#'
#' @param matrix matrix to be inverted.
#'
#' @return inverse or pseudo inverse of matrix.
#'
#' @export
rxInv <- function(matrix) {
.Call(`_rxode2_rxInv`, matrix)
}
#' Get Omega^-1 and derivatives
#'
#' @param invObjOrMatrix Object for inverse-type calculations. If
#' this is a matrix, setup the object for inversion
#' [rxSymInvCholCreate()] with the default arguments and return a
#' reactive s3 object. Otherwise, use the inversion object to
#' calculate the requested derivative/inverse.
#'
#' @param theta Thetas to be used for calculation. If missing (`NULL`), a
#' special s3 class is created and returned to access `Omega^1`
#' objects as needed and cache them based on the theta that is
#' used.
#'
#' @param type The type of object. Currently the following types are
#' supported:
#'
#' * `cholOmegaInv` gives the
#' Cholesky decomposition of the Omega Inverse matrix.
#' * `omegaInv` gives the Omega Inverse matrix.
#' * `d(omegaInv)` gives the `d(Omega^-1)` withe respect to the
#' theta parameter specified in `thetaNumber`.
#' * `d(D)` gives the `d(diagonal(Omega^-1))` with respect to
#' the theta parameter specified in the `thetaNumber`
#' parameter
#'
#' @param thetaNumber For types `d(omegaInv)` and `d(D)`,
#' the theta number that the derivative is taken against. This
#' must be positive from 1 to the number of thetas defining the
#' Omega matrix.
#'
#' @return Matrix based on parameters or environment with all the
#' matrixes calculated in variables `omega`, `omegaInv`, `dOmega`,
#' `dOmegaInv`.
#'
#' @author Matthew L. Fidler
#'
#' @export
rxSymInvChol <- function(invObjOrMatrix, theta = NULL, type = "cholOmegaInv", thetaNumber = 0L) {
.Call(`_rxode2_rxSymInvChol`, invObjOrMatrix, theta, type, thetaNumber)
}
rxSymInvCholEnvCalculate <- function(obj, what, theta = NULL) {
.Call(`_rxode2_rxSymInvCholEnvCalculate`, obj, what, theta)
}
rxOptRep_ <- function(input) {
.Call(`_rxode2_rxOptRep_`, input)
}
#' Stack a solved object for things like ggplot
#'
#' @param Data is a rxode2 object to be stacked.
#'
#' @param vars Variables to include in stacked data; By default this
#' is all the variables when vars is NULL.
#'
#' @return Stacked data with \code{value} and \code{trt}, where value is the values
#' and \code{trt} is the state and \code{lhs} variables.
#'
#' @author Matthew Fidler
rxStack <- function(Data, vars = NULL) {
.Call(`_rxode2_rxStack`, Data, vars)
}
rxRmvn_ <- function(A_, mu, sigma, ncores = 1L, isChol = FALSE) {
.Call(`_rxode2_rxRmvn_`, A_, mu, sigma, ncores, isChol)
}
rxMvnrnd <- function(n, L, l, u, mu, a = 0.4, tol = 2.05) {
.Call(`_rxode2_rxMvnrnd`, n, L, l, u, mu, a, tol)
}
rxCholperm <- function(Sig, l, u, eps = 1e-10) {
.Call(`_rxode2_rxCholperm`, Sig, l, u, eps)
}
rxGradpsi <- function(y, L, l, u) {
.Call(`_rxode2_rxGradpsi`, y, L, l, u)
}
rxNleq <- function(l, u, L) {
.Call(`_rxode2_rxNleq`, l, u, L)
}
rxMvrandn_ <- function(A_, mu, sigma, lower, upper, ncores = 1L, a = 0.4, tol = 2.05, nlTol = 1e-10, nlMaxiter = 100L) {
.Call(`_rxode2_rxMvrandn_`, A_, mu, sigma, lower, upper, ncores, a, tol, nlTol, nlMaxiter)
}
rxSeedEng <- function(ncores = 1L) {
.Call(`_rxode2_rxSeedEng`, ncores)
}
rxbinom_ <- function(n0, prob, n, ncores) {
.Call(`_rxode2_rxbinom_`, n0, prob, n, ncores)
}
rxcauchy_ <- function(location, scale, n, ncores) {
.Call(`_rxode2_rxcauchy_`, location, scale, n, ncores)
}
rxchisq_ <- function(df, n, ncores) {
.Call(`_rxode2_rxchisq_`, df, n, ncores)
}
rxexp_ <- function(rate, n, ncores) {
.Call(`_rxode2_rxexp_`, rate, n, ncores)
}
rxf_ <- function(df1, df2, n, ncores) {
.Call(`_rxode2_rxf_`, df1, df2, n, ncores)
}
rxgamma_ <- function(shape, rate, n, ncores) {
.Call(`_rxode2_rxgamma_`, shape, rate, n, ncores)
}
rxbeta_ <- function(shape1, shape2, n, ncores) {
.Call(`_rxode2_rxbeta_`, shape1, shape2, n, ncores)
}
rxgeom_ <- function(prob, n, ncores) {
.Call(`_rxode2_rxgeom_`, prob, n, ncores)
}
rxnorm_ <- function(mean, sd, n, ncores) {
.Call(`_rxode2_rxnorm_`, mean, sd, n, ncores)
}
rxpois_ <- function(lambda, n, ncores) {
.Call(`_rxode2_rxpois_`, lambda, n, ncores)
}
rxt__ <- function(df, n, ncores) {
.Call(`_rxode2_rxt__`, df, n, ncores)
}
rxunif_ <- function(low, hi, n, ncores) {
.Call(`_rxode2_rxunif_`, low, hi, n, ncores)
}
rxweibull_ <- function(shape, scale, n, ncores) {
.Call(`_rxode2_rxweibull_`, shape, scale, n, ncores)
}
rxRmvn0 <- function(A_, mu, sigma, lower, upper, ncores = 1L, isChol = FALSE, a = 0.4, tol = 2.05, nlTol = 1e-10, nlMaxiter = 100L) {
.Call(`_rxode2_rxRmvn0`, A_, mu, sigma, lower, upper, ncores, isChol, a, tol, nlTol, nlMaxiter)
}
rxRmvnSEXP <- function(nS, muS, sigmaS, lowerS, upperS, ncoresS, isCholS, keepNamesS, aS, tolS, nlTolS, nlMaxiterS) {
.Call(`_rxode2_rxRmvnSEXP`, nS, muS, sigmaS, lowerS, upperS, ncoresS, isCholS, keepNamesS, aS, tolS, nlTolS, nlMaxiterS)
}
rpp_ <- function(nS, lambdaS, gammaS, probS, t0S, tmaxS, randomOrderS) {
.Call(`_rxode2_rpp_`, nS, lambdaS, gammaS, probS, t0S, tmaxS, randomOrderS)
}
rxordSelect <- function(u, cs) {
.Call(`_rxode2_rxordSelect`, u, cs)
}
rxrandnV <- function(nrow, ncol) {
.Call(`_rxode2_rxrandnV`, nrow, ncol)
}
rxnormV_ <- function(mean, sd, n, ncores) {
.Call(`_rxode2_rxnormV_`, mean, sd, n, ncores)
}
#' Get the rxode2 seed
#'
#' @return rxode2 seed state or -1 when the seed isn't set
#'
#' @export
#' @seealso rxSetSeed, rxWithSeed, rxWithPreserveSeed
#' @examples
#'
#' # without setting seed
#'
#' rxGetSeed()
#' # Now set the seed
#' rxSetSeed(42)
#'
#' rxGetSeed()
#'
#' rxnorm()
#'
#' rxGetSeed()
#'
#' # don't use the rxode2 seed again
#'
#' rxSetSeed(-1)
#'
#' rxGetSeed()
#'
#' rxnorm()
#'
#' rxGetSeed()
#'
rxGetSeed <- function() {
.Call(`_rxode2_rxGetSeed`)
}
isNullZero <- function(obj) {
.Call(`_rxode2_isNullZero`, obj)
}
rxErf <- function(v) {
.Call(`_rxode2_rxErf`, v)
}
# Register entry points for exported C++ functions
methods::setLoadAction(function(ns) {
.Call('_rxode2_RcppExport_registerCCallable', PACKAGE = 'rxode2')
})